поиск рабочего листа для всех значений VBA Excel

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

Спасибо за ваши ответы. Я устал использовать оба метода, но по какой-то причине они, похоже, не работали. Они не дали мне ошибки, они просто ничего не дали. @ 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, и другой ответ, поскольку они лучше, если вы можете заставить их работать.

Answer 2

Я хотел бы предложить, чтобы загрузить данные в массив, а затем работать на этом массиве, а не работать на клетки и с помощью Функции рабочего листа.

'(...) 
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 3

Я использовал метод Range.Find() для поиска по каждой строке. Для каждой строки найденных данных, где введенное значение соответствует значению в столбце G, оно копирует эти данные в Sheet2. Вам нужно будет изменить имена переменных листа.

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 в соответствии с вашими требованиями.