Question

我有一个具有多个值的工作表，我想要做的是搜索列“B”表示值，当它发现它复制完整行并将其粘贴到其他地方时。我有一个类似的功能来做这个，但它找到第一个对我正在使用它的情况很好但是在这种情况下我需要它来复制所有匹配。下面是我现在使用的代码，它只给我一个值

    If ExpIDComboBox.ListIndex <> -1 Then
    strSelect = ExpIDComboBox.value
    lastRow = wks1.range("A" & Rows.Count).End(xlUp).row
    Set rangeList = wks1.range("A2:A" & lastRow)
    On Error Resume Next
        row = Application.WorksheetFunction.Match(strSelect, wks1.Columns(1), 0) ' searches the worksheet to find a match
    On Error GoTo 0
    If row Then

由于

Answer 1

我建议首先将数据加载到数组中，然后对此数组进行操作，而不是在单元格上运行并使用Worksheet函数。

'(...)
Dim data As Variant
Dim i As Long
'(...)


If ExpIDComboBox.ListIndex <> -1 Then
    strSelect = ExpIDComboBox.Value
    lastRow = wks1.Range("A" & Rows.Count).End(xlUp).Row

    'Load data to array instead of operating on worksheet cells directly - it will improve performance.
    data = wks1.Range("A2:A" & lastRow)


    'Iterate through all the values loaded in this array ...
    For i = LBound(data, 1) To UBound(data, 1)

        '... and check if they are equal to string [strSelect].
        If data(i, 1) = strSelect Then
            'Row i is match, put the code here to copy it to the new destination.
        End If

    Next i

End If

Answer 2

我使用Range.Find()方法搜索每一行。对于找到的每一行数据，您输入的值与G列中的值匹配，它会将此数据复制到Sheet2。您需要修改Sheet变量名称。

Option Explicit
Sub copyAll()
    Dim rngFound As Range, destSheet As Worksheet, findSheet As Worksheet, wb As Workbook
    Dim strSelect As String, firstFind As String

    Set wb = ThisWorkbook
    Set findSheet = wb.Sheets("Sheet1")
    Set destSheet = wb.Sheets("Sheet2")
    strSelect = ExpIDComboBox.Value
    Application.ScreenUpdating = False
    With findSheet
        Set rngFound = .Columns(7).Find(strSelect, LookIn:=xlValues)
        If Not rngFound Is Nothing Then
            firstFind = rngFound.Address
            Do
                .Range(.Cells(rngFound.Row, 1), .Cells(rngFound.Row, _
                    .Cells(rngFound.Row, .Columns.Count).End(xlToLeft).Column)).Copy
                destSheet.Cells(destSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteAll 
                Set rngFound = .Columns(2).Find(strSelect, LookIn:=xlValues, After:=.Range(rngFound.Address))
            Loop While firstFind <> rngFound.Address
        End If
    End With
    Application.ScreenUpdating = True
End Sub

我以为你会在A：G列之间有数据吗？否则，您只需修改.Copy和.PasteSpecial方法即可满足您的要求。

Answer 3

感谢您的回复。我厌倦了使用这两种方法但由于某种原因它们似乎不起作用。他们没有给我一个错误，他们只是没有产生任何东西。@ mielk我明白你使用数组做这个意味着什么，它会更快更快乐但我没有足够的VBA知识来调试为什么那没起效。我尝试了其他方法，并最终使其工作，并认为它可能在将来有用，试图让这个工作。再次感谢您的回答：）

Private Sub SearchButton2_Click()
Dim domainRange As range, listRange As range, selectedString As String, lastRow As Long, ws, wks3 As Excel.Worksheet, row, i As Long
Set wks3 = Worksheets("Exceptions") '<----- WorkSheet for getting exceptions
If DomainComboBox.ListIndex <> -1 Then '<----- check that a domain has been selected
    selectedString = DomainComboBox.value
    lastRow = wks3.range("A" & Rows.Count).End(xlUp).row ' finds the last full row
    Set listRange = wks3.range("G2:G" & lastRow) 'sets the range from the top to the last row to search
    i = 2
    'used to only create a new sheet is something is found
    On Error Resume Next
        row = Application.WorksheetFunction.Match(selectedString, wks3.Columns(7), 0) ' searches the worksheet to find a match
    On Error GoTo 0
    If row Then
        For Each ws In Sheets
            Application.DisplayAlerts = False
            If (ws.Name = "Search Results") Then ws.Delete 'deletes any worksheet called search results
            Next
            Application.DisplayAlerts = True
        Set ws = Sheets.Add(After:=Sheets(Sheets.Count)) 'makes a new sheet at the end of all current sheets
        ws.Name = "Search Results" 'renames the worksheet to search results
        wks3.Rows(1).EntireRow.Copy 'copys the headers from the exceptions page
        ws.Paste (ws.Cells(, 1)) 'pastes the row into the search results page
        For Each domainRange In listRange ' goes through every value in worksheet trying to match what has been selected
            If domainRange.value = selectedString Then
            wks3.Rows(i).EntireRow.Copy ' copys the row that results was found in
            emptyRow = WorksheetFunction.CountA(ws.range("A:A")) + 1 ' finds next empty row
            ws.Paste (ws.Cells(emptyRow, 1)) 'pastes the contents
            End If
            i = i + 1 'moves onto the next row
        ws.range("A1:Q2").Columns.AutoFit 'auto fit the columns width depending on what is in the a1 to q1 cell
        ws.range("A1:Q1").Cells.Interior.ColorIndex = (37) 'fills the header with a colour
        Application.CutCopyMode = False 'closes the paste funtion to stop manual pasting
        Next domainRange ' goes to next value
    Else
        MsgBox "No Results", vbInformation, "No Results" 'display messgae box if nothing is found
        Exit Sub
    End If
End If
End Sub

感谢。

N.B。这不是最有效的方式来阅读mielk的答案和其他答案，因为如果你能让他们工作，他们会更好。

在工作表中搜索所有值VBA Excel

3 个答案: