Question

在我的工作簿中五张纸的三个（Bakery，Floral，Grocery）的B列中，我想找到B列中有Flyer字的行。每个工作表中都会有多行在列B中添加单词Flyer。当找到单词Flyer时，它会将整行粘贴到Sheet1中。

我将其用于一个标签，但是想要使用相同的代码搜索所有三个标签（但不是全部五个...这就是问题）并粘贴所有带有Flyer字样的行B列进入Sheet1。

我的代码（有效，但仅限于面包店标签）：

Sub CopyRowsFlyer()
'This looks in the Bakery tab and moves everything that has "Flyer" in     column B to Sheet 1
  Dim bottomB As Integer
  Dim x As Integer
  bottomB = Sheets("Bakery").Range("B" & Rows.Count).End(xlUp).Row: x = 1

  Dim c As Range
  For Each c In Sheets("Bakery").Range("B3:B" & bottomB)
    If c.Value = "Flyer" Then
        c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
        x = x + 1
    End If
  Next c
End Sub

Answer 1

将所需的工作表名称存储在数组中并循环显示它们。

Sub CopyRowsFlyer()
    Dim bottomB As Long, b As Long, x As Long
    Dim w As Long, vWSs As Variant
    vWSs = Array("Bakery", "Floral", "Grocery")

    x = 1
    For w = LBound(vWSs) To UBound(vWSs)
        With Worksheets(vWSs(w))
            bottomB = .Range("B" & Rows.Count).End(xlUp).Row
            For b = 3 To bottomB
                If LCase(.Cells(b, "B").Value) = "flyer" Then
                    .Rows(b).EntireRow.Copy Worksheets("sheet1").Range("A" & x)
                    x = x + 1
                End If
            Next b
        End With
    Next w

End Sub

虽然与.Range.Find method等其他方法相比，这种循环遍历每个工作表B列中的单元格的方法被认为效率低，但它对较小的数据集不会产生很大的影响。如果要检查每个工作表上有大量行，您可能希望探索其他更直接的检索信息的途径。

Answer 2

您只想循环浏览所需的三张纸。试试这个：

 Sub CopyRowsFlyer()
 'This looks in the Bakery tab and moves everything that has "Flyer" in     column B to Sheet 1
   Dim bottomB As Integer
   Dim x As Integer
   Dim SheetsArray() As Variant
   Dim ws As WorkSheet
   Dim i As Integer       

   SheetsArray = Array("Bakery", "Sheet2Name", "Sheet3Name")
   For i = LBound(SheetsArray) To UBound(SheetsArray)
        Set ws = Sheets(SheetsArray(i))
        bottomB = ws.Range("B" & Rows.Count).End(xlUp).Row: x = 1

        Dim c As Range
        For Each c In ws.Range("B3:B" & bottomB)
              If c.Value = "Flyer" Then
                    c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
                    x = x + 1
              End If
        Next c
   Next i
 End Sub

Answer 3

您可以在表格中用字符串数组的元素替换ID。

以下是您修改后的代码。

Sub CopyRowsFlyer()
  Dim bottomB As Integer
  Dim x As Integer
  Dim sheetName(1 to 3) As String, i as Integer
  sheetName(1) = "Bakery"
  sheetName(2) = "Floral"
  sheetName(3) = "Grocery"
  x=1
  For i = 1 to 3
    bottomB = Sheets(sheetName(i)).Range("B" & Rows.Count).End(xlUp).Row

    Dim c As Range
    For Each c In Sheets(sheetName(i)).Range("B3:B" & bottomB)
        If c.Value = "Flyer" Then
            c.EntireRow.Copy Worksheets("sheet1").Range("A" & x)
            x = x + 1
        End If
    Next c
  Next i
End Sub

Answer 4

与发布的其他解决方案类似。很简单。替换范围检查的边界。变量最小。没有执行中期的维度。

Sub CopyRowsFlyer()
  Dim strSh As Variant, c As Range, x As Integer
  x = 1

  For Each strSh In Array("Bakery", "Floral", "Grocery")
    For Each c In Worksheets(strSh).Range("B:B")
      If c = "" and c.Row > 2 Then
        Exit For
      ElseIf c = "Flyer" and c.Row > 2 Then
        c.EntireRow.Copy Worksheets("Sheet1").Range("A" & x)
        x = x + 1
      End If
    Next
  Next
End Sub

多个工作表上的同一列中的查找值

4 个答案: