在sheet1和sheet2中搜索相同的值，并将值从sheet1复制到sheet2

1 回答

• 0

  我有点不清楚你想做什么 . 这是我的解释：假设，对于工作表1中第X行A列中的值 - 如果在第Y行B列中的工作表2上找到相应的值 - 您希望从工作表1复制第X行所属的单元格到ABCD列并将它们粘贴在第Y行BCD页的第2页上 .

  如果这是正确的，请尝试这样做：

  Sub copyCells()
      Dim wb As Workbook, firstWs As Worksheet, secondWs As Worksheet
      Dim matchIndex As Integer
  
      Set wb = ThisWorkbook
      Set firstWs = wb.Worksheets(1)
      Set secondWs = wb.Worksheets(2)
  
      Application.ScreenUpdating = False
  
      ' We'll start at i=2 to account for the header
      For i = 2 To firstWs.Range("A2:A6000").Rows.count
          On Error Resume Next
          ' MATCH will find the row number in sheet 2 - change the range specifications as needed
          matchIndex = Application.WorksheetFunction.Match(firstWs.Range("A" & i), secondWs.Range("B2:B6000"), 0)
          Err.Clear
          On Error GoTo 0
  
          ' MATCH will throw an error if it finds no results.
          ' Hence: if matchindex contains an error, do nothing.
          ' But if it doesn't contain an error, it must contain a row number - so we can proceed.
          If Not Application.WorksheetFunction.IsNA(matchIndex) Then
              secondWs.Range("B" & matchIndex).Value = firstWs.Range("A" & i).Value
              secondWs.Range("C" & matchIndex).Value = firstWs.Range("B" & i).Value
              secondWs.Range("D" & matchIndex).Value = firstWs.Range("C" & i).Value
              secondWs.Range("E" & matchIndex).Value = firstWs.Range("D" & i).Value    
          End If
      Next i
  
      Application.ScreenUpdating = True
  End Sub
  

  回复于 2024-04-26T18:03:42+08:00