Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

38047 / 76732

←次へ　｜　前へ→


	【43828】Re:別シートのデータを条件別に取得

モナ - 06/10/26(木) 13:48 -


	引用なし

	パスワード

以下のマクロで動かしています。
素人記述です。
なんとか、無駄を省いたスマートな記述にできればと思います。
【43794】で書いてくださったソースに
うまくきれいにはめてすっきりさせていただけないでしょうか？
それを元に勉強したいと思います。

1.マクロ11

Sub test1()
　　Set WS1 = Worksheets("元")
　　Set WS2 = Worksheets("ＯＫ")
　　Set WS3 = Worksheets("ＯＫ２")
　　Dim Rtn As Integer
　　
　　
　　Workbooks.Open Filename:="甲.xls"
　　
　　With Worksheets("甲").Range("A1")　'★ここのWithを整理したい。
　　　　.Range("A1:B4").Copy Destination:=WS2.Range("A1")
　　　　.Range("A1:B4").Copy Destination:=WS3.Range("A1")
　　End With
　　　　
　　With Worksheets("joblog").Range("G6")
　　　　.AutoFilter Field:=7, Criteria1:="ftime"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS2.Range("A6")
　　　　
　　　　.AutoFilter Field:=7, Criteria1:="ntime"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS3.Range("A6")
　　　　
　　　　.AutoFilter Field:=7, Criteria1:="<>ftime", Operator:=xlAnd, _
　　　　Criteria2:="<>ntime"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS1.Range("A1")
　　　　
　　　　.AutoFilter
　　End With
　　Workbooks("甲.xls").Close
　　
　　　’★ここで、「甲.xlsは変更されています。保存しますか？」のMsgボックスが出てくるが、自動的にNo(保存しない)を選択して閉じたい
　　
　　WS1.Activate
End Sub

2.マクロ12（1-2-1と1-2-2をくっつけました）
Sub FromTo作成()
　　Set WS1 = Worksheets("元")
　　Set WS4 = Worksheets("抽出")
　　Set WS4 = Worksheets("エラー")

　　Dim FT As String
　　
　　With WS1.Range("A1")
　　FT = (WS1.Range("N2").Value = WS1.Range("P2").Value)

　　If FT = "False" Then
　　　　.Range("N1:N65536").Copy Destination:=WS2.Range("A1")
　　　　.Range("P1:P65536").Copy Destination:=WS2.Range("B1")
　　　　.Range("D1:D65536").Copy Destination:=WS2.Range("F1")
　　　　.Range("X1:X65536").Copy Destination:=WS2.Range("G1")
　　　　
　　Else
　　　　.Range("N1:N65536").Copy Destination:=WS2.Range("A1")
　　　　.Range("O1:O65536").Copy Destination:=WS2.Range("B1")
　　　　.Range("Q1:Q65536").Copy Destination:=WS2.Range("C1")
　　　　.Range("D1:D65536").Copy Destination:=WS2.Range("F1")
　　　　.Range("X1:X65536").Copy Destination:=WS2.Range("G1")
　　End If
　　End With
　　
　　WS4.Activate
　　
End Sub

2 hits

▼

【43790】別シートのデータを条件別に取得 モナ 06/10/25(水) 21:04