从多个工作表更新主工作表

如何解决从多个工作表更新主工作表

嗨，我正在尝试创建一个宏，将源表中的数据提取到主表中，它会检查主表中是否存在任何现有记录，如果有，它将更新主表中的记录使用源工作表中的最新数据，如果没有，它将源工作表中的数据添加到主工作表中。我设法将下面的代码拼凑在一起，它可以为一个客户（单张纸）做到这一点，谁能建议如何修改它以允许更新多张纸。了解我需要循环工作表才能做到这一点，但到目前为止我遇到了错误。非常感谢任何帮助！

Sub Update()
Dim wsSrc As Worksheet,wsDest As Worksheet,i As Integer,j As Integer,k As Integer,srcLastRow As Long,destLastRow As Long,srcFndVal As String,destFndCell As Range,srcValRow As Long,destValRow As Long,destFndVal As String,srcFndCell As Range
Application.ScreenUpdating = False
Set wsSrc = Worksheets("Cust A")
Set wsDest = Worksheets("Master")
srcLastRow = wsSrc.Cells(Rows.Count,"BA").End(xlUp).Row
destLastRow = wsDest.Cells(Rows.Count,"A").End(xlUp).Row
j = wsDest.Cells(Rows.Count,"A").End(xlUp).Offset(1,0).Row
    With wsDest
        For i = 4 To srcLastRow
        srcFndVal = wsSrc.Cells(i,"AA")
        Set destFndCell = .Range("A:A").Find(srcFndVal,LookIn:=xlValues)
            If destFndCell Is nothing And wsSrc.Cells(i,"AA").Value <> "" Then
                .Range("A" & j & ":F" & j).Value = wsSrc.Range("AA" & i & ":AF" & i).Value
                .Range("J" & j & ":K" & j).Value = wsSrc.Range("AG" & i & ":AH" & i).Value
                .Range("G" & j & ":H" & j).Value = wsSrc.Range("AE" & i & ":AF" & i).Value
                j = j + 1
            Else
        srcValRow = wsSrc.Range("AA:AA").Find(what:=srcFndVal,after:=wsSrc.Range("AA4"),LookIn:=xlValues).Row
        destValRow = wsDest.Range("A:A").Find(what:=srcFndVal,after:=wsDest.Range("A4"),LookIn:=xlValues).Row
                .Range("B" & destValRow & ":F" & destValRow).Value = wsSrc.Range("AB" & srcValRow & ":AF" & srcValRow).Value
                .Range("J" & destValRow & ":K" & destValRow).Value = wsSrc.Range("AG" & srcValRow & ":AH" & srcValRow).Value
            End If
        Next
        For k = 4 To destLastRow
        destFndVal = wsDest.Cells(k,"A")
        Set srcFndCell = wsSrc.Range("AA:AA").Find(destFndVal,LookIn:=xlValues)
            If srcFndCell Is nothing And wsDest.Cells(k,"A").Value <> "" Then
                .Range("B" & k & ":F" & k).Value = vbNullString
            End If
        Next
    End With
Application.ScreenUpdating = True
End Sub

我修改了代码以遍历数组中的工作表，但是在获取 wsSrc 的最后一行时存在问题，需要运行时错误 424 对象。突出显示了下面的行，有人可以建议如何解决这个问题吗？抱歉，我是 VBA 新手，非常感谢您的帮助。

srcLastRow = wsSrc.Cells(Rows.Count,"AA").End(xlUp).Row

Sub Update()
Dim wsSrc As Variant,srcList As Variant,srcFndCell As Range
Application.ScreenUpdating = False
srcList = Array("Cust A","Cust B","Cust C","Cust D","Cust E","Cust F","Cust G")
Set wsDest = Worksheets("Master")
srcLastRow = wsSrc.Cells(Rows.Count,"AA").End(xlUp).Row
destLastRow = wsDest.Cells(Rows.Count,0).Row
For Each wsSrc In srcList
    With wsDest
        For i = 4 To srcLastRow
        srcFndVal = wsSrc.Cells(i,"A").Value <> "" Then
                .Range("B" & k & ":F" & k).Value = vbNullString
            End If
        Next
    End With
Next wsSrc
Application.ScreenUpdating = True
End Sub

解决方法

试试这个

Sub Update()
    Dim wsSrc  As Worksheet
    For Each wsSrc In ThisWorkbook.Worksheets
        If wsSrc.Name <> "Master" Then
            'Do bla bla...
        End If
    Next
End Sub

,

我已经修复了你的代码。试试这个。 你的问题是 wsSrc 是一个 WorkSheet 对象，但 srcList 是一个字符串数组。它们彼此不匹配。 我使用 wsSrc 名称以“Cust”开头的条件。告诉我这是否解决了您的问题

Sub Update()
    Dim wsSrc,wsDest As Worksheet
    Dim i,j,k As Integer
    Dim srcLastRow,destLastRow,srcValRow,destValRow As Long
    Dim srcFndVal,destFndVal As String
    Dim destFndCell,srcFndCell As Range
    
    Application.ScreenUpdating = False
    Set wsDest = Worksheets("Master")
    For Each wsSrc In ThisWorkbook.Worksheets
        If Left(wsSrc.Name,4) = "Cust" Then
            srcLastRow = wsSrc.Cells(Rows.Count,"BA").End(xlUp).Row
            destLastRow = wsDest.Cells(Rows.Count,"A").End(xlUp).Row
            j = wsDest.Cells(Rows.Count,"A").End(xlUp).Offset(1,0).Row
            With wsDest
                For i = 4 To srcLastRow
                    srcFndVal = wsSrc.Cells(i,"AA")
                    Set destFndCell = .Range("A:A").Find(srcFndVal,LookIn:=xlValues)
                    If destFndCell Is Nothing And wsSrc.Cells(i,"AA").Value <> "" Then
                        .Range("A" & j & ":F" & j).Value = wsSrc.Range("AA" & i & ":AF" & i).Value
                        .Range("J" & j & ":K" & j).Value = wsSrc.Range("AG" & i & ":AH" & i).Value
                        .Range("G" & j & ":H" & j).Value = wsSrc.Range("AE" & i & ":AF" & i).Value
                        j = j + 1
                    Else
                        srcValRow = wsSrc.Range("AA:AA").Find(what:=srcFndVal,after:=wsSrc.Range("AA4"),LookIn:=xlValues).Row
                        destValRow = wsDest.Range("A:A").Find(what:=srcFndVal,after:=wsDest.Range("A4"),LookIn:=xlValues).Row
                        .Range("B" & destValRow & ":F" & destValRow).Value = wsSrc.Range("AB" & srcValRow & ":AF" & srcValRow).Value
                        .Range("J" & destValRow & ":K" & destValRow).Value = wsSrc.Range("AG" & srcValRow & ":AH" & srcValRow).Value
                    End If
                Next
                For k = 4 To destLastRow
                    destFndVal = wsDest.Cells(k,"A")
                    Set srcFndCell = wsSrc.Range("AA:AA").Find(destFndVal,LookIn:=xlValues)
                    If srcFndCell Is Nothing And wsDest.Cells(k,"A").Value <> "" Then .Range("B" & k & ":F" & k).Value = vbNullString
                Next
            End With
        End If
    Next
    Application.ScreenUpdating = True
End Sub