【问题标题】:Update Worksheet by comparing it to another Worksheet通过将工作表与另一个工作表进行比较来更新工作表
【发布时间】:2018-06-11 15:07:50
【问题描述】:

我有一个 Excel 工作表(“Sheet1”),需要与另一个工作表(“Sheet2”)进行比较。

两个工作表的格式完全相同。 (即列是相同的,具有相同的标题)

在比较 Sheet1 和 Sheet2 时,我需要检查现有记录的更新。

还要检查 Sheet2 中不存在于 Sheet1 中的新记录,并将它们附加到 Sheet1 的底部。

工作表 2 中的某些列是完全空白的,不需要检查。

第 2 列将是“关键”

另外请记住,每个工作表中有超过 7000 行。

更新#1:

使用字典对象,我想出了这个。但是,它似乎没有找到任何新条目。我做错了吗?

Sub createDictionary()
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    Dim maxRows1, maxRows2 As Long
    Dim i, j As Integer
    Dim SheetOne, SheetTwo As Worksheet

    maxRows1 = Sheets("Sheet1").UsedRange.Rows.Count

    Set SheetOne = Sheet1
    Set SheetTwo = Sheet2

    For i = 2 To maxRows1

        If Not dict.exists(SheetOne.Cells(i, 2).Value + " " + SheetOne.Cells(i, 11).Value) Then
            dict.Add CStr(SheetOne.Cells(i, 2).Value) + " " + SheetOne.Cells(i, 11).Value, i
        End If

    Next i

    maxRows2 = Sheets("Sheet2").UsedRange.Rows.Count

    For j = 2 To maxRows2

        If Not dict.exists(Sheet2.Cells(j, 2).Value) Then
            SheetTwo.Range("A" & j & ":" & "Z" & j).Copy
            SheetOne.Range("A" & maxRows1 + 1).Insert Shift:=xlDown
            SheetOne.Range("A" & maxRows1 + 1).Interior.Color = RGB(200, 200, 200)
        End If

    Next j

    Set dict = Nothing
End Sub

【问题讨论】:

  • 老实说,我是 VBA Excel 的新手,不知道从哪里开始。
  • 我尝试了一些别人给我的东西,他们在一个小数据集上工作,但是当我应用它时总是崩溃。
  • 你应该把这段代码放在这里(编辑你的问题),我们用它作为开始,让它适用于你的大型数据集。
  • 这是另一个用户试图帮助我解决此问题的链接。他给我的很多东西都超出了我的想象。 stackoverflow.com/a/25067335/3891378

标签: vba excel


【解决方案1】:

尝试使用dictionary 对象,它可以容纳的数量没有限制(唯一的限制是您的计算机)

我将遍历 sheet1,将每个键添加到字典中,并将其映射到一个集合,该集合存储 rowIndex 和由行值生成的散列。然后循环遍历 sheet2 中的键,查看每个键是否存在于字典中;如果没有,则将该行复制到 sheet1。如果键确实存在,则对 sheet2 中的行进行哈希处理并与字典项进行比较,如果它们不同,则您知道需要更新该行。

要快速复制并粘贴一行,您可以简单地访问 ow 的 value2 属性。这在更新时附加 + 时很有用

这里有一些测试代码可以帮助您入门。

Sub loopCellInColumn()
    Dim cell As Object
    Dim sheet As Worksheet
    Dim rng As Range
    Set sheet = ActiveSheet
    Set rng = sheet.UsedRange.Columns("A").Cells

    For Each cell In rng
        Row = cell.Row
        cell.Value = "Hello World" & Row
    Next cell
End Sub

以及使用字典:

Sub createDictionary()
    Dim dict As Object
    Dim value As Collection
    Set dict = CreateObject("Scripting.Dictionary")

    Key = "hello"
    Set value = New Collection
    value.Add 100, "row"
    value.Add "A2D121E4", "hash"
    dict.Add Key, value

    MsgBox "key exists: " & dict.exists(Key) & vbNewLine & "value: " & dict(Key).Item("hash")
End Sub

使用 value2 复制 + 粘贴:

Sub test()
    ActiveSheet.Rows(1).Value2 = ActiveSheet.Rows(2).Value2
End Sub

获取一行作为字符串的例子:

Sub getRowAsString()
    Dim cell As Object
    Dim sheet As Worksheet
    Dim str As String
    Dim arr() As Variant
    Dim arr2() As Variant
    Dim printCol As Integer

    Set sheet = ActiveSheet
    printCol = sheet.UsedRange.Columns.Count + 1

    For Each cell In sheet.UsedRange.Rows
        arr = cell.Value2
        ReDim arr2(LBound(arr, 2) To UBound(arr, 2))

        For i = LBound(arr, 2) To UBound(arr, 2)
            arr2(i) = arr(1, i)
        Next i

        str = Join(arr2, ", ")
        ActiveSheet.Cells(cell.Row, printCol).Value = str
    Next cell
End Sub

Here 是从字符串中获取哈希值的帖子,包括vba代码:

我列出的所有步骤都有许多支持它们的帖子,因此资源不会成为问题

【讨论】:

  • 好的,所以您所描述的只是将新元素附加到 sheet1。关于从哪里开始使用 sheet2 中的信息(如果不同)更新 sheet1 中的行的任何提示?
  • @user3891378 更新了帖子以包含更新行的示例以及确定行是否需要更新的有效方法(您不希望每次都遍历一行中的每个值)。还更新了字典示例,以便将集合存储为其值
  • 贴出了我想出的尝试使用这个字典对象的代码,但还是有一些问题。
【解决方案2】:

我经常在这个论坛上重复这一点:),但是,使用 SQL 来处理此类操作要容易得多。

我会使用 Microsof Query(Excel 数据->获取外部数据->从其他来源->从 Microsoft Query)或者我建议使用我的 SQL 加载项到 Excel:http://blog.tkacprow.pl/?page_id=130

似乎您需要使用 JOIN 运算符来查找表 1 和 2 之间的更改。然后使用 UNION 运算符加入第二个 SELECT 和 LEFT OUTER JOIN 以添加额外的新行。

【讨论】:

    猜你喜欢
    • 2023-03-15
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多