谁是谁，什么是什么

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

Answer 2

您将要在末尾添加一个If语句。我尚未对此进行测试，但是它应该使您了解如何使它工作。

'Your need to change this to what you need
Dim CustomerSheet = Customerworkbook.Worksheets("Sheet1")

If Customersheet.range("C11").value = targetSheet.range("A1").value then
    targetSheet.Range("B14", "G500").Value = sourceSheet.Range("A2", "G500").Value
Else
    Exit Sub
End If

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

2 个答案:

谁是谁，什么是什么