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

时间:2014-10-09 21:25:28

标签: vb.net excel-vba data-transfer vba excel

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

我有2张大型Excel表格,其中一张是S / N和详细信息,另一张是日期,名称和时间段。我需要脚本完成的是对两张纸进行运行,当它从表1的A列和表2的A列中找到匹配的单元格时,它将获取表2和#39中的所有数据;匹配行并将其附加到工作表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

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

3 个答案:

答案 0 :(得分:0)

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)

然后向下拖动

答案 1 :(得分:0)

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

答案 2 :(得分:-1)

我同意之前的答案:看来这个要求最容易用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