VBA - 「平均」＆「StDev」の検索列 - 見つかった場合は列全体を新しいワークシートにコピー

Question

averageまたはStdevをrow 7に含むすべての列をワークシートから検索しようとしています。列全体を新しいワークシートに追加します。次のコードを試してみましたが、ワークシート内のすべてではなく、列の1つだけをコピーするように見えます。

Sub FindAverage() 

    Dim c As Range  
    Set c = Rows(7).Find("*Average*", LookAt:=xlWhole) 

    If c Is Nothing Then 
     Exit Sub 
    ElseIf Not c Is Nothing Then 
     Columns(c.Column).Copy Destination:=Sheets("Sheet2").Columns("A:A") 
     Application.CutCopyMode = False 
    End If 

End Sub 

本当にありがとうございます。

Answer 1

Findを使用して2つの値を検索すると、「組み込み」ではないため、追加のコードを記述する必要があります。

以下のコードは、Find関数を使用して、範囲内のすべての「平均」を検索します。したがって、 "StDev"を見つけるために別のループを実行する必要があります。

Sub FindAverage() 

Dim c As Range 
Dim col As Long 
Dim firstAddress As String 

With Worksheets("Sheet3").Rows(7) 
    Set c = .Find("*Average*", LookIn:=xlValues) 
    If Not c Is Nothing Then 
     col = 1 
     firstAddress = c.Address 
     Columns(c.Column).Copy Destination:=Sheets("Sheet4").Columns(col) 

     Do 
      Set c = .FindNext(c) 
      If c Is Nothing Then 
       Exit Sub 
      End If 

      C.EntireColumn.Copy Destination:=Sheets("Sheet4").Columns(col)     
      col = col + 1 
      Application.CutCopyMode = False 
     Loop While Not c Is Nothing And c.Address <> firstAddress 
    End If 
End With 

End Sub 

---

オプション2：行7における占有範囲内で定期的にループを使用します。

Sub FindAverageansStdev() 

Dim C As Range 
Dim col As Long, LastCol As Long 

With Worksheets("Sheet3") 
    LastCol = .Cells(7, .Columns.Count).End(xlToLeft).Column '<-- get last column with data in row 7 
    col = 1 
    For Each C In .Range(.Cells(7, 1), .Cells(7, LastCol)) ' <-- loop through occupied cells only in row 7 
     If C.Value Like "*Average*" Or C.Value Like "*StDev*" Then 
      C.EntireColumn.Copy Destination:=Sheets("Sheet4").Columns(col)  
      ' option to pastespecial (values only) 
      C.EntireColumn.Copy 
      Sheets("Sheet4").Columns(col).PasteSpecial xlPasteValues    
      col = col + 1 
     End If 
    Next C 
End With 

End Sub