Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6601 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【44263】Select Caseの使い方教えて下さい 魚 06/11/11(土) 12:22 質問[未読]
【44265】Re:Select Caseの使い方教えて下さい ToShiYo 06/11/11(土) 13:53 発言[未読]
【44267】Re:Select Caseの使い方教えて下さい 魚 06/11/11(土) 14:27 質問[未読]
【44270】Re:Select Caseの使い方教えて下さい neptune 06/11/11(土) 22:23 回答[未読]
【44282】Re:Select Caseの使い方教えて下さい maverick 06/11/12(日) 0:25 発言[未読]
【44285】Re:Select Caseの使い方教えて下さい Kein 06/11/12(日) 1:09 回答[未読]
【44305】Re:Select Caseの使い方教えて下さい 魚 06/11/12(日) 19:27 お礼[未読]
【44263】Select Caseの使い方教えて下さい
質問  魚  - 06/11/11(土) 12:22 -
引用なし
パスワード
   ＶＢＡ初心者です。
以下のソースをSelect Caseになおしたかったのですが、
うまくいきません。
どなたか教えてください。


Sub Test()
　　Set WS1 = Worksheets("Ａ")
　　Set WS2 = Worksheets("Ｂ")
　　Set WS3 = Worksheets("Ｃ")

　　Workbooks.Open (data.xls)

　　With Worksheets("data").Range("X6")
　　　 .AutoFilter Field:=10, Criteria1:="OK"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS2.Range("A6")
　　　　
　　　　.AutoFilter Field:=10, Criteria1:="NG"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS3.Range("A6")
　　　　
　　　　.AutoFilter Field:=10, Criteria1:="<>OK", Operator:=xlAnd, _
　　　　Criteria2:="<>NG"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS1.Range("A1")
　　　　
　　　　.AutoFilter
　　End With
　　WS1.Activate
End Sub
【44265】Re:Select Caseの使い方教えて下さい
発言  ToShiYo  - 06/11/11(土) 13:53 -
引用なし
パスワード
   ▼魚 さん：
このコードの内容がいまいち分からないのですが･･･
あえてselect caseを使えば、こんな感じでしょうか

Sub Test2()
　　Set WS1 = Worksheets("A")
　　Set WS2 = Worksheets("B")
　　Set WS3 = Worksheets("C")

'　　Workbooks.Open (data.xls)･･･これは？不要では。

　　With Worksheets("data").Range("X6")
　　　　.AutoFilter
　　　Select Case Range("J2")
　　　 Case Is = "OK"
　　　　.AutoFilter Field:=10, Criteria1:="OK"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS2.Range("A6")
　　　　.AutoFilter
　　　 Case Is = "NO"
　　　　.AutoFilter Field:=10, Criteria1:="NG"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS3.Range("A6")
　　　　.AutoFilter
　　　　
　　　Case Else
　　　　.AutoFilter Field:=10, Criteria1:="<>OK", Operator:=xlAnd, _
　　　　Criteria2:="<>NG"
　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS1.Range("A1")
　　End Select
　　　　.AutoFilter
　　End With
　　WS1.Activate
End Sub
【44267】Re:Select Caseの使い方教えて下さい
質問  魚  - 06/11/11(土) 14:27 -
引用なし
パスワード
   ▼ToShiYo さん：
ありがとうございます。
別ブックのシートからデータを抽出するマクロで
あえて途中のみを切り出して記述させていただきました。

書いていただいたコードですが、

>　　　 Case Is = "OK"
>　　　　.AutoFilter Field:=10, Criteria1:="OK"　★
>　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS2.Range("A6")★
>　　　　.AutoFilter★
>　　　 Case Is = "NO"

この★の部分の繰り返しは簡潔にできないものなんでしょうか？
ここはやはり省略してはいけない箇所ですか？
【44270】Re:Select Caseの使い方教えて下さい
回答  neptune  - 06/11/11(土) 22:23 -
引用なし
パスワード
   ▼魚 さん　
こんにちは

ToShiYo さんではありませんが、思う所を。
>>　　　 Case Is = "OK"
>>　　　　.AutoFilter Field:=10, Criteria1:="OK"　★
>>　　　　.CurrentRegion.SpecialCells(xlVisible).Copy WS2.Range("A6")★
>>　　　　.AutoFilter★
>>　　　 Case Is = "NO"
>
>この★の部分の繰り返しは簡潔にできないものなんでしょうか？
>ここはやはり省略してはいけない箇所ですか？
省略は出来ませんが、"OK"、WS2.Range("A6")、等の変化する部分を変数に
収めることによって、AutoFilter 、コピー関係の同じ記述は避けられます。
【44282】Re:Select Caseの使い方教えて下さい
発言  maverick  - 06/11/12(日) 0:25 -
引用なし
パスワード
   ▼魚 さん：
>以下のソースをSelect Caseになおしたかったのですが、
あえて AutoFilter を使わずにループを使って Select Case に
してみました。(AutoFilterには太刀打ちできませんが・・・)

Sub Test()
　　Set WS1 = Worksheets("Ａ")
　　Set WS2 = Worksheets("Ｂ")
　　Set WS3 = Worksheets("Ｃ")

　　With Worksheets("data").Range("X6")
　　　　With .Resize(, .End(xlToRight).Column)
　　　　　　.Copy WS2.Range("A6")
　　　　　　.Copy WS3.Range("A6")
　　　　　　.Copy WS1.Range("A1")
　　　　End With
　　　　
　　　　For i = 1 To .End(xlDown).Row - .Row
　　　　　　Set rng = .Offset(i).Resize(, .Offset(i).End(xlToRight).Column)
　　　　　　Select Case .Offset(i, 9).Value
　　　　　　　　Case "OK"
　　　　　　　　　　　 rng.Copy WS2.Range("A25536").End(xlUp).Offset(1)
　　　　　　　　Case "NG"
　　　　　　　　　　　 rng.Copy WS3.Range("A25536").End(xlUp).Offset(1)
　　　　　　　　Case Else
　　　　　　　　　　　 rng.Copy WS1.Range("A25536").End(xlUp).Offset(1)
　　　　　　End Select
　　　　Next i
　　End With
　　WS1.Activate
End Sub

※シートからの抽出では AutoFilter は強力な機能です(最強?)
【44285】Re:Select Caseの使い方教えて下さい
回答  Kein  - 06/11/12(日) 1:09 -
引用なし
パスワード
   フィルターを使わず、IV列に数式を埋めて判定・処理するコードです。

Sub Data_Distribute()
　 Dim xR As Long, xC As Long
　 Dim MyR As Range
　
　 Application.ScreenUpdating = False
　 On Error Resume Next
　 Workbooks("data.xls").Activate
　 If Err.Number <> 0 Then
　　　Workbooks.Open ThisWorkbook.Path & "\data.xls"
　　　Err.Clear
　 End If
　 On Error GoTo 0
　 With ActiveWorkbook.Worksheets("data")
　　　With .Range("X6").CurrentRegion
　　　　 xR = .Rows.Count + 5: xC = .Columns.Count
　　　End With
　　　Set MyR = .Range("X7:X" & xR).Resize(, xC)
　　　On Error Resume Next
　　　With Range("IV7:IV" & xR)
　　　　 .Formula = "=IF(AG7=""OK"",1,IF(AG7=""NG"",""A"",FALSE))"
　　　　 Intersect(MyR, .SpecialCells(3, 1).EntireRow) _
　　　　 .Copy ThisWorkbook.Worksheets("Ｂ").Range("A6")
　　　　 Intersect(MyR, .SpecialCells(3, 2).EntireRow) _
　　　　 .Copy ThisWorkbook.Worksheets("Ｃ").Range("A6")
　　　　 Intersect(MyR, .SpecialCells(3, 4).EntireRow) _
　　　　 .Copy ThisWorkbook.Worksheets("Ａ").Range("A1")
　　　　 .ClearContents
　　　End With
　 End With
　 With ThisWorkbook
　　　.Activate: .Worksheets("Ａ").Activate
　 End With
　 Application.ScreenUpdating = True: Set MyR = Nothing
End Sub
【44305】Re:Select Caseの使い方教えて下さい
お礼  魚  - 06/11/12(日) 19:27 -
引用なし
パスワード
   皆さん、ありがとうございます。
いろんなパターンの記述があってとても参考になりました。
Kein さんのコードが一番難しかったのですが、
そこを目指してスキルアップがんばりたいと思います。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
6601 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free