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 -

引用なし
パスワード
   VBA初心者です。
以下のソースをSelect Caseになおしたかったのですが、
うまくいきません。
どなたか教えてください。


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

  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("A")
  Set WS2 = Worksheets("B")
  Set WS3 = Worksheets("C")

  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("B").Range("A6")
     Intersect(MyR, .SpecialCells(3, 2).EntireRow) _
     .Copy ThisWorkbook.Worksheets("C").Range("A6")
     Intersect(MyR, .SpecialCells(3, 4).EntireRow) _
     .Copy ThisWorkbook.Worksheets("A").Range("A1")
     .ClearContents
   End With
  End With
  With ThisWorkbook
   .Activate: .Worksheets("A").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