VBA - 将两列中的单元格与另外两列中的单元格进行比较

3 回答

• 0

  循环直到你的工作表上有数据：

  Option Explicit
  Sub matcher()
  
      Dim i As Integer, j As Integer
  
      i = 1
      While Sheets(1).Cells(i, 1).Value <> ""
          j = 1
          While Sheets(2).Cells(j, 1).Value <> ""
  
              If Sheets(1).Cells(i, 1).Value = Sheets(2).Cells(j, 1).Value And Sheets(1).Cells(i, 2).Value = Sheets(2).Cells(j, 2).Value Then
                  Sheets(1).Cells(i, 1).Interior.ColorIndex = 3
              End If
  
              j = j + 1
          Wend
          i = i + 1
      Wend
  End Sub
  

  回复于 2024-04-26T16:45:08+08:00
• 0

  关闭，如此接近 .

  我对您的代码所做的大部分更改都是“装饰性的”（例如，使用“B”而不是从“A”中偏移一列） .

  main 更改是 If 语句 . 在"cosmetic"更改后，您的 If 语句最终看起来像：

  If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
      If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
          ws.Range("A" & i).Interior.Color = vbRed
      End If
      Exit For
  End If
  

  问题是，只要A列中的值匹配，就会退出 For j 循环，即使B列中的值不匹配也是如此 . 只有在A列和B列匹配时才需要执行 Exit For ，例如，

  If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
      If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
          ws.Range("A" & i).Interior.Color = vbRed
          Exit For
      End If
  End If
  

  ---

  在完成所有更改后，最终代码最终为：

  Sub Comparestwocolumns()
  
      Dim i As Long
      Dim j As Long
      Dim lastrow As Long
      Dim ws As Worksheet
  
      Set ws = Sheet1
      Set ws2 = Sheet2
  
      For i = 1 To 500000
          If IsEmpty(ws.Range("A" & i)) Then
              Exit For
          End If
  
          For j = 1 To 500000
              If IsEmpty(ws2.Range("A" & j)) Then
                  Exit For
              End If
  
              If ws.Range("A" & i).Value = ws2.Range("A" & j).Value Then
                  If ws.Range("B" & i).Value = ws2.Range("B" & j).Value Then
                      ws.Range("A" & i).Interior.Color = vbRed
                      Exit For
                  End If
              End If
          Next j
      Next i
      MsgBox ("Finished ")
  End Sub
  

  回复于 2024-04-26T16:45:08+08:00
• 1

  你可以使用AutoFilter（）：

  Option Explicit
  
  Sub Comparestwocolumns()
      Dim firstShtRng  As Range, filteredRng As Range, colorRng As Range, cell As Range
  
      With Worksheets("Sheet2") '<--| reference your 2nd sheet
          Set firstShtRng = .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| gather its column A values from row 1 down to last not empty row to be checked in 2nd sheet
      End With
  
      With Sheets("Sheet1") '<--| reference your 1st sheet
          With .Range("A1", .cells(.Rows.Count, 1).End(xlUp)) '<--| reference its column A range from row 1 down to last not empty row
              .AutoFilter Field:=1, Criteria1:=Application.Transpose(firstShtRng.Value), Operator:=xlFilterValues '<--| filter referenced cells with 'firstShtRng' values
              Set filteredRng = .SpecialCells(xlCellTypeVisible) '<--| set filtered cells to 'filteredRng' range
              Set colorRng = .Offset(, 1).Resize(1, 1) '<--| initialize 'colorRng' to a "dummy" cell that's out of range of interest: it'll be used to avoid subsequent checking against "nothing" before calling 'Union()' method and eventually discharged
          End With
          .AutoFilterMode = False
      End With
  
      For Each cell In filteredRng '<--| loop through filtered cells in "Sheet1"
          If firstShtRng.Find(What:=cell.Value, LookIn:=xlValues, LookAt:=xlWhole).Offset(, 1) = cell.Offset(, 1) Then Set colorRng = Union(colorRng, cell) '<--| if current cell adjacent value matches corresponding value in "Sheet2" then update 'colorRng'
      Next
      Set colorRng = Intersect(filteredRng, colorRng) '<--| get rid of "dummy" cell
      If Not colorRng Is Nothing Then colorRng.Interior.Color = vbRed '<--| if any survived cell in "Sheet1" then delete corresponding rows
  End Sub
  

  回复于 2024-04-26T16:45:08+08:00