VBA - 「平均」和「StDev」的搜索列 - 如果發現將整列複製到新工作表

Question

我想通過我的工作表搜索包含average或Stdev,row 7的所有列，並且如果他們複製整列到一個新的工作表。我試過下面的代碼，但它似乎只複製其中一列而不是全部在工作表中。

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函數來查找範圍內的所有「Average」。所以你需要運行另一個循環來找到「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