Question

我需要使用一个宏，它将根据单元格的文本是否与另一行匹配来复制和粘贴整行。我在网站上寻找类似的东西，但却找不到可能有用的东西。我将概述我正在尝试的过程：

从一个工作表复制并粘贴一个程序名称列表（名称数量可能不同）。（这个我已经完成了）
分别检查每个程序名称（程序数量可能会有所不同），以查看它是否与单独的表单上的单独列表匹配。
如果匹配，请复制并粘贴整行，如果不匹配则移至下一行。

我尝试使用if和then语句，但我遇到了尝试循环它的问题（如果那是正确的术语）。列表的大小可能会有所不同，因此确保在宏中考虑这一点非常重要。以下是我到目前为止的情况：

复制并粘贴初始列表功能

Sub Report_P1()    
  Dim wsPivot As Worksheet: Set wsPivot = ThisWorkbook.Sheets("Pivot")
  Dim wsReport As Worksheet: Set wsReport = ThisWorkbook.Sheets("Report")

  wsPivot.Select
  Range("A4", Range("A65536").End(xlUp)).Select
  Application.CutCopyMode = False
  Selection.Copy
  wsReport.Select
  Range("A3").Select
  ActiveSheet.Paste          
End Sub

我需要帮助的过滤工具

Sub Report_P2()
  Dim i As Integer
  Dim j As Integer
  Dim wsReport As Worksheet: Set wsReport = ThisWorkbook.Sheets("Report")
  Dim wsData As Worksheet: Set wsData = ThisWorkbook.Sheets("Data")

  For i = 1 To 10              
    If wsReport.Cells(i, 1) = wsData.Cells(i, 1) Then
      wsData.Select
      Range(i).Select
      'Application.CutCopyMode = False
      Range(i).Copy
      wsReport.Select
      Range(i).Select
      ActiveSheet.Paste
    End If
  Next i    
End Sub

感谢您的帮助！

Answer 1

Sub Report_P2()

Dim i As Integer
Dim j As Integer
Dim wsReport As Worksheet: Set wsReport = ThisWorkbook.Sheets("Report")
Dim wsData As Worksheet: Set wsData = ThisWorkbook.Sheets("Data")

  For i = 1 To 10

            If wsReport.Cells(i, 1) = wsData.Cells(i, 1) Then
            wsData.Select
                Rows(i).Select
                Selection.Copy
            wsReport.Activate
                Range("A" & i).Activate
                ActiveSheet.Paste
                End If
                Application.CutCopyMode = False
    Next i

End Sub

Or more concisely：

For i = 1 To 10
   If wsReport.Cells(i, 1) = wsData.Cells(i, 1) Then
      wsData.Rows(i).Copy Destination:=wsReport.Range("A" & i)
   End If
Next i

复制和过去匹配

1 个答案: