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个值，不是＆＃34;内置＆＃34;，您需要编写一些额外的代码。

以下代码使用Find功能查找所有＆＃34;平均值＆＃34;范围中。所以你需要运行另一个循环来查找＆＃34; StDev＆＃34;。

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

VBA - “平均”的搜索列＆amp; “StDev” - 如果找到将整列复制到新工作表

1 个答案: