excel - 当工作簿 1 中的单元格值与工作簿 2 中的列值匹配时，将值从工作簿 2 复制到工作簿 1(主工作簿)

Question

我正在编写代码以根据标准将数据从工作簿 2 复制到工作簿 1(主工作簿)。

标准是 - 如果工作簿 1(主工作簿)中单元格 C11 的值等于工作簿 2 的 A 列，则将工作簿 2 列 A 到 F 的所有数据复制到工作簿 1(主工作簿)。请注意，可能需要将多个匹配值(在工作簿 2 中)复制到工作簿 1。

我已经尝试了以下代码，可以完美地提取所有数据。现在我正在尝试查看是否有可用于根据标准复制数据的代码。

Private Sub CommandButton1_Click()

' Get Tiger calendar workbook...
Dim customerBook As Workbook
Dim filter As String
Dim caption As String
Dim customerFilename As String
Dim customerWorkbook As Workbook
Dim targetWorkbook As Workbook

' make weak assumption that active workbook is the target
Set targetWorkbook = Application.ActiveWorkbook

' get the Tiger calendar workbook
filter = "Text files (*.xlsx),*.xlsx"
caption = "Please Select the Tiger Calendar file"
customerFilename = Application.GetOpenFilename(filter, , caption)

Set customerWorkbook = Application.Workbooks.Open(customerFilename)

' assume range is A1 - M10000 in sheet1
' copy data from Tiger calendar to target workbook
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets("Sheet1")
Dim sourceSheet As Worksheet
Set sourceSheet = customerWorkbook.Worksheets(1)

targetSheet.Range("B14", "G500").Value = sourceSheet.Range("A2", "G500").Value

' Close customer workbook
customerWorkbook.Close

End Sub

例如，如果工作簿 1 中的单元格 C11 = 1232223(产品 ID)，则复制的数据应该是与产品 ID 相关的所有销售明细。批量数据在工作簿 2 中可用。

Answer 1

谁是谁，什么是什么

在此工作簿中，对照源工作簿 A 列中的值检查单元格 C11。找到后，将行范围和 6 个连续列 (A-F) 从 B14 (B-G) 开始复制到此工作簿。执行所有这些操作，直到到达源工作簿中的最后一行数据。

Private Sub CommandButton1_Click()

  Const filter As String = "Text files (*.xls*),*.xls*"
  Const caption As String = "Please Select the Tiger Calendar file"

  Const wsTarget As Variant = "Sheet1"  ' Target Worksheet Name/Index
  Const cTgtFirst As String = "B14"     ' Target First Cell Range
  Const cTgtSearch As String = "C11"    ' Target Search Value Cell Range
  Const wsSource As Variant = 1         ' Source Worksheet Name/Index
  Const cSrcFirst As Long = 2           ' Source First Row
  Const cSrcFirstCol As Variant = "A"   ' Source First Column Letter/Number
  Const cColumns As Integer = 6         ' Number of Columns

  Dim customerFilename As String
  Dim sourceSheet As Worksheet
  Dim i As Long
  Dim rngTarget As Range

  customerFilename = Application.GetOpenFilename(filter, , caption)

  Set sourceSheet = Workbooks.Open(customerFilename).Worksheets(wsSource)

  With sourceSheet
    Set rngTarget = ThisWorkbook.Worksheets(wsTarget).Range(cTgtFirst)
    For i = cSrcFirst To .Cells(.Rows.Count, cSrcFirstCol).End(xlUp).Row
      If .Cells(i, cSrcFirstCol) = rngTarget.Parent.Range(cTgtSearch) Then
        .Cells(i, cSrcFirstCol).Resize(, cColumns).Copy _
            rngTarget.Resize(, cColumns)
        Set rngTarget = rngTarget.Offset(1, 0)
      End If
    Next
  End With

  sourceSheet.Parent.Close False

End Sub