Excel VBA - 比较两列中的值并将匹配的行复制到新工作表

2 回答

• 1

  正如Scott Craner指出的那样，基于 foundTrue 更新 lastRowM 无法正常工作 . 只要每次向Sheet3添加新行时更新 lastRowM ，都不需要 foundTrue . 我已将其保存在代码中，以防您在未找到值时显示消息.2923494_

  Sub compareAndCopy()
  
      Dim lastRowE As Long
      Dim lastRowF As Long
      Dim lastRowM As Long
      Dim foundTrue As Boolean
  
      ' stop screen from updating to speed things up
      Application.ScreenUpdating = False
  
      lastRowE = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
      lastRowF = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
      lastRowM = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "B").End(xlUp).Row
  
      For i = 1 To lastRowE
          foundTrue = False
          For j = 1 To lastRowF
  
              If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
                  lastRowM = lastRowM + 1
                  Sheets("Sheet2").Rows(i).Copy Destination:= _
                             Sheets("Sheet3").Rows(lastRowM)
                  foundTrue = True
                  Exit For
              End If
          Next j
          'If Not foundTrue Then
          '    MsgBox ("didn't find string: " & Sheets("Sheet2").Cells(i, 2).value)
          'End If
      Next i
  
      ' stop screen from updating to speed things up
      Application.ScreenUpdating = True
  End Sub
  

  回复于 2024-04-19T11:32:31+08:00
• 2

  遵循你的措辞：

  我正在尝试将sheet2中的列A与sheet1中的columnA进行比较，当匹配时，将行从sheet1复制到sheet3 .

  你可以试试这个

  Sub RowFinder()
      Dim sheet1Data As Variant
  
      With Worksheets("Sht2") '<--| reference your worksheet 2
          sheet1Data = Application.Transpose(.Range("A1", .Cells(.Rows.count, 1).End(xlUp)).Value)
      End With
      With Worksheets("Sht1") '<--| reference your worksheet 1
          With .Range("A1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its column A cells from row 1 (header) down to last not empty one
              .AutoFilter field:=1, Criteria1:=sheet1Data, Operator:=xlFilterValues '<--| filter cells with sheet 2 column A values
              If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Intersect(.Parent.UsedRange, .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy Destination:=Worksheets("Sht3").Range("A1")
          End With
          .AutoFilterMode = False
      End With
  End Sub
  

  回复于 2024-04-19T11:32:31+08:00