☰

比较和更新电子表格

tag-icon • tag-icon microsoft-excel worksheet-function vba
比较和更新电子表格

请帮我处理一下 Excel 电子表格。我有两个工作表，一个保存旧记录，另一个保存当前记录。我希望开发一个与命令按钮关联的 VBA 代码，见下面的示例，这样当单击按钮时，旧记录中的值将根据新记录中的值自动更新。为了清楚起见，这里是工作表的快照。

Sheet1 包含旧记录，这些记录是实时的并且可以被 100 多个用户查看。Sheet2 包含新记录，这些记录从各种来源进行更新，并且任何字段/列都可以由字段用户更改。

两个工作表中的字段 1 都包含主要控制字段。因此，我想要做的是获取 Sheet2 中字段 1 的每个值，然后在 Sheet1 的字段 1 中搜索该值，如果该值存在，我想要比较所有相应的记录，以便将 Sheet2 中的所有字段的任何差异复制到 Sheet1。如果该值根本不在 Sheet1 中，我想要将 Sheet2 中的所有值和所有相关记录复制到 Sheet1。我总是想要根据 Sheet2 中的新更新不断更新 Sheet1。

我希望我说得足够清楚。请注意，示例表只是一个简化版本，因为表中有 75 个字段/列和超过 70,000 条记录。

感谢您为实现这一目标所提供的帮助和支持。

**SHEET1**
Field1  Field2  Field3  Field4
Radms Street    781772  2   76
Mapre Street    781772  31  76
Catapilar Av    781727  1   90
Aveb Park   781727  56  91

**SHEET2**
Field1  Field2  Field3  Field4
Aveb Park   781727  56  91
Radms Street    781770  2   76
Solution Way    761111  67  1
Aknyt Road  781720  91  90
Mapre Street    781772  31  76
weedred Park    781781  23  61
Raven Road  781781  76  61
Catapilar Av    781720  21  76

答案1

此 VBA 可以工作，只需调整单元格范围，这样它就不会无限期地运行。还可以调整 for 循环i以反映您有多少个字段。

此 VBA 假定两个工作表中的值的顺序相同，并且不会替换空白，但也会不比较值。

Sub comparesheets()
Application.ScreenUpdating = False
Dim c As Range
Dim strFind As String
Dim rFound As Range
Dim i As Integer

For Each c In Sheets("sheet1").Range("A:A")
strFind = c.Value

    With Sheets("Sheet2").Range("A:A")
        Set rFound = .Find(What:=strFind, _
                        After:=.Cells(.Cells.Count), _
                        LookIn:=xlValues, _
                        LookAt:=xlWhole, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)
        If Not rFound Is Nothing Then
            For i = 1 To 4
                If rFound.Offset(, i) <> "" Then
                    c.Offset(, i) = rFound.Offset(, i)
                End If
            Next i

        End If
    End With

Next c
Application.ScreenUpdating = True
End Sub

相关内容