需要一个脚本将数据从一个 Excel 工作表传输到另一个工作表

Question

我有一个用户每天都使用 Excel 工作表。她花了很多时间将数据从一张纸转移到另一张纸上，并要求我找到一个可以自动化某些流程的脚本/宏/公式。我四处搜索，发现一些脚本看起来很接近我们的需要，但我不是 Excel VBA 脚本方面的专家，所以我不确定如何修改它来完成我们需要的。

我有 2 张大 Excel 表格，一张填满了 S/N 和详细信息，另一张填满了日期、姓名和时间段。我需要脚本完成的是对两张表运行，当它从表 1 的 A 列和表 2 的 A 列中找到匹配的单元格时，它将从表 2 的匹配行中获取所有数据并将其附加到末尾工作表 1 上的匹配行。

这是我想要完成的一个示例：

SN112233 Apple
SN112244 Orange            SHEET 1
SN112255 Grape


SN112211 01/01/14 Mike 5Days
SN112222 02/02/14 Tim 2Days          SHEET 2
SN112233 05/03/14 Rick 8Days
SN112244 24/03/14 Tim 1Day
SN112255 11/04/14 Daryl 12Days

脚本运行后，数据最终会在表格 1 上看起来像这样

SN112233  Apple  05/03/14  Rick  8 Days
SN112244  Orange 24/03/14  Tim   1 Day         SHEET 1
SN112255  Grape  11/04/14  Daryl 12 Days

这是我发现的其中一个脚本，看起来它在我需要完成的工作的正确轨道上，但我不确定如何修改它以完成我需要完成的所有事情：

Sub MatchAndCopy()

    Dim sheet01 As Worksheet, sheet02 As Worksheet
    Dim c As Range, matchingCell As Long
    Dim RangeInSheet1 As Range
    Dim RangeInSheet2 As Range
    Dim dict As Object, tmp
    Set dict = CreateObject("scripting.dictionary")

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = True

    Set sheet01 = Worksheets("Sheet1")
    Set sheet02 = Worksheets("Sheet2")

    Set RangeInSheet1 = sheet01.Range(sheet01.Range("A2"), _
              sheet01.Cells(Rows.count, 1).End(xlUp))
    Set RangeInSheet2 = sheet02.Range(sheet02.Range("A2"), _
              sheet02.Cells(Rows.count, 1).End(xlUp))

    'populate dictionary...
    For Each c In RangeInSheet1.Cells
        tmp = c.Value
        If Not dict.exists(tmp) Then
            dict.Add tmp, c.Row
        End If
    Next c

    For Each c In RangeInSheet2.Cells
      tmp = c.Value
      If dict.exists(tmp) Then
        Application.StatusBar = "Please wait while data is being copied," & _
                                " Processing count : " & c.Row
        sheet01.Cells(dict(tmp), "F").Resize(1, 5).Value = _
                c.Offset(0, 1).Resize(1, 5).Value
      End If
    Next c

    Application.StatusBar = False
    Application.ScreenUpdating = True

End Sub

对此的任何帮助将不胜感激！

Answer 1

sheet1 C1 的公式：=VLOOKUP(A1,SHEET2!$A$1:$D$5,2,FALSE)
sheet1 D1 的公式：=VLOOKUP(A1,SHEET2!$A$1:$D$5,3,FALSE)
sheet1 E1 的公式：=VLOOKUP(A1,SHEET2!$A$1:$D$5,4,FALSE)

然后向下拖动

Answer 2

要扩展 user3616725 的另一个答案，您可以通过将单元格称为 SHEET1!$A$1 在工作表之间进行链接。您可以通过[workbook.xlsx]SHEET1!$A$1 依次链接整个工作簿，但这要求它们位于同一个文件夹中。您可以通过在 [workbook.xlsx] 部分中指定绝对路径来链接到单独的文件夹。

Answer 3

我同意前面的回答：看来这个要求最容易用 Excel 公式来满足。

这个答案主要是关于如何在必要时开发 VBA 解决方案的建议。

我不认为搜索似乎与您的要求模糊匹配的大型代码块然后修改该块是正确的方法。您找到的任何代码块都可能包含您不理解的 VBA 功能。你知道什么是字典吗？你知道如何使用字典吗？在这种情况下，字典会是正确的解决方案吗？

如果您要编写 VBA 宏，则必须学习 VBA。在网上搜索“Excel VBA 教程”。有很多可供选择，因此请选择与您的学习风格相匹配的一种。我更喜欢书。我参观了最近的大城镇的图书馆，并查看了他们的 Excel VBA 入门书。我借了一些，所以我可以在家里尝试它们。最后我去了一家书店，买了一本最适合我的书。必要时我会翻阅那本书。无论哪种方法适合您，花在学习 VBA 上的时间都会很快得到回报。

您必须将您的要求分解为您已经了解 VBA 的简单步骤，或者您可以期望在您的书中找到一些有用的代码，或者如果您在网络上搜索过。

您想从另一个工作表更新。一般来说，我从不更新工作表，因为如果在宏完成之前出现问题，我已经损坏了工作表。我通常会创建一个新工作表并从源工作表构建它。如果出现任何问题，重新启动很容易。如果合适，我将在新工作表完成后删除原始工作表。您知道如何创建新工作表或删除现有工作表吗？您可以搜索“Excel VBA：创建工作表”并期望找到有用的答案。但是，我会启动宏记录器并创建一些工作表并从键盘上删除它们。然后我会检查生成的代码以发现创建和删除工作表的语句。

在这种情况下，您将在现有行的末尾添加新列，因此重新启动宏不会有问题。

您的宏的核心将是一个检查 Sheet1 中每一行的循环。任何有关在线教程的书都会向您展示如何做到这一点。搜索“Excel VBA：查找工作表的最后一行”将为您提供相关代码。

我可以继续，但我希望我已经为您提供了关于设计和创建需求解决方案的充分介绍，

有许多类似的方法可以满足您的要求。哪种方法最好并不总是很明显，要求很小，所以我选择了一种我希望易于理解的方法。

Option Explicit     ' Look up thi statement to see why its inclusion is good practice
Sub MergeSheets()

  ' Using constants for columns means your code:
  '  * takes longer to write
  '  * is easier to read and debug
  '  * can be updated quickly if a column moves

  ' Note my naming style. I start with what I use the variable or constant for.
  ' Eg: "Col" for column. I then add words that narrow down the use until I
  ' have a unique name. I am not asking you to like my style but to develop a
  ' style of your own. I can look at macros I wrote years ago and immediately
  ' know what all the variables are which is a big help.

  ' I have used "One" and "Two" to identify the sheets because "1" and "2" are
  ' too short. However, you should give meaningful naems to your worksheets.

  Const ColOneSN As Long = 1
  Const ColOneProduct As Long = 2
  Const ColOneDateFinished As Long = 3
  Const ColOnePerson As Long = 4
  Const ColOneDuration As Long = 5
  Const ColOneDurationUnit As Long = 6

  Const ColTwoSN As Long = 1
  Const ColTwoDateFinished As Long = 2
  Const ColTwoPerson As Long = 3
  Const ColTwoDuration As Long = 4
  Const ColTwoDurationUnit As Long = 5

  Dim DateFinished As Date
  Dim Duration As Long
  Dim DurationUnit As String
  Dim Person As String
  Dim Rng As Range
  Dim RowOneCrnt As Long
  Dim RowOneLast As Long
  Dim SN As String
  Dim WshtOne As Worksheet
  Dim WshtTwo As Worksheet

  Set WshtOne = Worksheets("Sheet1")
  Set WshtTwo = Worksheets("Sheet2")

  ' Assume column widths in WshtTwo are corect and use them for WshtOne
  WshtOne.Columns(ColOneDateFinished).ColumnWidth = WshtTwo.Columns(ColTwoDateFinished).ColumnWidth
  WshtOne.Columns(ColOnePerson).ColumnWidth = WshtTwo.Columns(ColTwoPerson).ColumnWidth
  WshtOne.Columns(ColOneDuration).ColumnWidth = WshtTwo.Columns(ColTwoDuration).ColumnWidth
  WshtOne.Columns(ColOneDurationUnit).ColumnWidth = WshtTwo.Columns(ColTwoDurationUnit).ColumnWidth

  RowOneLast = WshtOne.Cells(Rows.Count, ColOneSN).End(xlUp).Row

  ' Start value for For Loop assumes no header row as in your example.
  ' You could use a constant such as RowOneDataFirst if a header line
  ' might be added later or if the number of lines mught change.

  For RowOneCrnt = 1 To RowOneLast
    ' Extract SN to search for from WshtOne
    With WshtOne
      SN = .Cells(RowOneCrnt, ColOneSN).Value
    End With
    With WshtTwo
      ' Search SN column of WshtTwo for SN
      Set Rng = .Columns(ColTwoSN).Find(What:=SN)
      If Rng Is Nothing Then
        ' This SN not found

        ' Add code for this sitation

      Else
        ' SN found
        DateFinished = .Cells(Rng.Row, ColTwoDateFinished).Value
        Person = .Cells(Rng.Row, ColTwoPerson).Value
        Duration = .Cells(Rng.Row, ColTwoDuration).Value
        DurationUnit = .Cells(Rng.Row, ColTwoDurationUnit).Value
      End If
    End With
    If Not Rng Is Nothing Then
      ' Copy values into WshtOne
      With WshtOne
        .Cells(RowOneCrnt, ColOneDateFinished).Value = DateFinished
        .Cells(RowOneCrnt, ColOnePerson).Value = Person
        .Cells(RowOneCrnt, ColOneDuration).Value = Duration
        .Cells(RowOneCrnt, ColOneDurationUnit).Value = DurationUnit
      End With
    End If

  Next

End Sub