时间戳

首页 > 解决方案 > 从多个工作表更新主工作表

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

问题描述

我正在尝试将源工作表中的数据提取到主工作表中。

我为一位客户拼凑了代码（单张）。

我如何修改它以允许更新多个工作表？

我知道我需要循环工作表，但我遇到了错误。

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

I modified the code to loop through the worksheets in an array however there is an issue with getting the last row of the wsSrc.

>Run-time error 424 Object required.

Below line is highlighted

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

```vba
Sub Update()
    Dim wsSrc As Variant, srcList As Variant, 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
    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, "A").End(xlUp).Row
    j = wsDest.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
    For Each wsSrc In srcList
        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
    Next wsSrc
    Application.ScreenUpdating = True
End Sub

标签： excelvba

解决方案

我已经修复了你的代码。尝试这个。你的问题是 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

推荐阅读