Question

我尝试使用VBA创建搜索工具，以查找用户输入的给定SearchString的所有工作表中的所有事件。它应该在名为＆＃34; Search＆＃34;的工作表的相应列中的不同工作表中粘贴找到此SearchString的整行。如下图所示：

因此，表单Free REQs中的行应该开始粘贴在单元格A11中，并粘贴在连续的行中，直到在Free ReQs表中找不到更多的对应关系，然后在Temporary表中找到的行应该开始了粘贴在单元格N11中，依此类推所有图纸（不同图纸中的表格与“搜索”表格中的相应表格具有相同的列数）。为此，我有以下代码（TableColumn是搜索表中每个表开始的列，例如，对于免费REQ，它将是＆＃34; B＆＃34;）：

Private Sub OKButton_Click()
    Dim TableColumn As String
    Dim SearchString As String
    Dim SheetNames() As Variant
    Dim Loc As Range
    Dim CurrentRow

    SearchString = TextBox.Value

    'Sheets where we want to find stuff
    SheetNames = Array("Free REQs", "Temporary", "FTE", "Hierarchy", "all REQs", "EMEA TEAM")

    'Code to find all occurrences in all sheets MAKE SEPARATE SUB FOR THIS (from: http://stackoverflow.com/questions/19504858/find-all-matches-in-workbook-using-excel-vba)
    'Start filling the results table in row 11
    CurrentRow = 11

    For Each Sh In SheetNames
        TableColumn = GetTableBeginColumn(Sh)
        With Sheets(Sh)
            'Find in all sheets where SearchString ocurrs
            Set Loc = .UsedRange.Cells.Find(What:=SearchString)
            If Not Loc Is Nothing Then
                Do Until Loc Is Nothing
                    'Copy the data from the original source
                    .Rows(Loc.Row).EntireRow.Copy
                    'Paste it into the Search sheet
                    ActiveSheet.Paste Destination:=Sheets("Search").Range(TableColumn & CurrentRow)
                    'Find the next occurrence of SearchString
                    Set Loc = .UsedRange.FindNext(Loc)
                    'Fill the next empty row next
                    CurrentRow = CurrentRow + 1
                Loop
            End If
        End With
        CurrentRow = 11
        Set Loc = Nothing
    Next

End Sub

虽然，对于这一行：

ActiveSheet.Paste Destination:=Sheets("Search").Range(TableColumn & CurrentRow)

我收到错误：

即使TableColumn & CurrentRow对应于定义单个单元格的字符串。我在这里缺少什么？

Answer 1

尝试这个小重构

Option Explicit

Private Sub OKButton_Click()
    Dim TableColumn As String
    Dim SearchString As String
    Dim SheetNames() As Variant
    Dim Loc As Range
    Dim CurrentRow
    Dim sh As Variant
    Dim firstAddress As String

    SearchString = TextBox.Value

    'Sheets where we want to find stuff
    SheetNames = Array("Free REQs", "Temporary", "FTE", "Hierarchy", "all REQs", "EMEA TEAM")

    'Code to find all occurrences in all sheets MAKE SEPARATE SUB FOR THIS (from: http://stackoverflow.com/questions/19504858/find-all-matches-in-workbook-using-excel-vba)
    'Start filling the results table in row 11
    CurrentRow = 11

    For Each sh In SheetNames
        TableColumn = GetTableBeginColumn(sh)
        With Sheets(sh)
            'Find in all sheets where SearchString ocurrs
            Set Loc = .UsedRange.Cells.Find(What:=SearchString)
            If Not Loc Is Nothing Then
                firstAddress = Loc.Address '<--| store first found cell address
                Do
                    'Copy the data from the original source
                    Intersect(.Rows(Loc.Row).EntireRow, .UsedRange).Copy Destination:=Sheets("Search").Range(TableColumn & CurrentRow) '<--| copy only a "finite" amount of columns
                    'Find the next occurrence of SearchString
                    Set Loc = .UsedRange.FindNext(Loc)
                    'Fill the next empty row next
                    CurrentRow = CurrentRow + 1
                Loop While Loc.Address <> firstAddress '<--| loop until 'Find()' wraps back to first found cell
            End If
        End With
        CurrentRow = 11
        Set Loc = Nothing
    Next

End Sub

无法使用VBA将整个行从一个工作表复制到另一个工作表

1 个答案: