excel 什么是更有效的方法来写这个？

h22fl7wq 于 2023-04-13 发布在其他

关注(0)|答案(2)|浏览(138)

工作簿包含汇总工作表和随机数量的估算工作表。此子表使用手动更新按钮填充汇总工作表。大多数数据位于已知的固定单元格中。一些数据位于估算工作表上的随机行中。我正在使用函数查找这些行。此子表运行缓慢。我确信这是'大锤'方法。我应该先将单元格值写入数组，然后粘贴到摘要表中吗？还是其他更好的方法？

Sub UpdateSummary()
    Call ParaOff
    Dim i As Integer
    Dim j As Integer
    Dim x As Integer
    Dim name As String
    j = 5
    Call HideX
    Call SortWorksheets
    If Not WorksheetExists(wsF) Then
        MsgBox "ERROR: Worksheet '" & wsF & "' is missing."
    Else
        'Sheets(wsF).Activate
        Worksheets(wsF).Range("B7:U41").ClearContents
        Worksheets(wsF).Range("W7:W41").ClearContents
        For i = 1 To Worksheets.Count
            If Worksheets(i).name <> wsF And Worksheets(i).name <> wsG And Worksheets(i).name <> wsI And Worksheets(i).name <> wsJ And Worksheets(i).name <> wsK Then
                Worksheets(i).Range("S1").Copy 'PROJECT
                Worksheets(wsF).Range("B" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("J6").Copy 'LOCATION
                Worksheets(wsF).Range("C" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("Q1").Copy 'DURATION
                Worksheets(wsF).Range("D" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("M1").Copy 'PROJECT TOTAL
                Worksheets(wsF).Range("E" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("S10").Copy 'MISC %
                Worksheets(wsF).Range("F" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("S11").Copy 'MISC $
                Worksheets(wsF).Range("G" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("N10").Copy 'OTHER %
                Worksheets(wsF).Range("H" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("N11").Copy 'OTHER $
                Worksheets(wsF).Range("I" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("P13").Copy 'GC TOTAL
                Worksheets(wsF).Range("J" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("K11").Copy 'GC %
                Worksheets(wsF).Range("K" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("L11").Copy 'GC DAY
                Worksheets(wsF).Range("L" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("M11").Copy 'GC MONTH
                Worksheets(wsF).Range("M" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("S14").Copy 'PM %
                Worksheets(wsF).Range("N" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("K14").Copy 'PM HRS
                Worksheets(wsF).Range("O" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("S16").Copy 'SUPER %
                Worksheets(wsF).Range("P" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("K16").Copy 'SUPER HRS
                Worksheets(wsF).Range("Q" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("S18").Copy 'PE %
                Worksheets(wsF).Range("R" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("K18").Copy 'PE HRS
                Worksheets(wsF).Range("S" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Worksheets(i).Range("Q10").Copy 'CARP HRS
                Worksheets(wsF).Range("T" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                x = fFindRowByCol(Worksheets(i).name, "I", "Div 26*")
                Worksheets(i).Range("P" & x).Copy 'DIV 26 $
                Worksheets(wsF).Range("U" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                x = fFindRowByCol(Worksheets(i).name, "I", "Div 32*")
                Worksheets(i).Range("P" & x).Copy 'DIV 32 $
                Worksheets(wsF).Range("W" & j + i).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            End If
        Next i
    End If
    Call ParaOn
    Call Happy
End Sub

excel

来源：https://stackoverflow.com/questions/75924642/what-is-a-more-effective-way-to-write-this

2条答案

按热度按时间

yhived7q1#

摆脱冗长的重复行

...通过使用变量和数据结构（例如数组，字典（集合））...

说明

此代码通过复制和粘贴工作簿中其他工作表的数据来更新工作簿中的摘要工作表。
密码

Sub UpdateSummary()
    ' PROJECT, LOCATION,  DURATION, PROJECT TOTAL, MISC %,   MISC $, OTHER %,
    ' OTHER $, GC TOTAL,  GC %,     GC DAY,        GC MONTH, PM %,   PM HRS,
    ' SUPER %, SUPER HRS, PE %,     PE HRS,        CARP HRS
    
    ' Define constants.
    Dim sCells(): sCells = VBA.Array( _
        "S1", "J6", "Q1", "M1", "S10", "S11", "N10", _
        "N11", "P13", "K11", "L11", "M11", "S14", "K14", _
        "S16", "K16", "S18", "K18", "Q10")
    Dim dCols(): dCols = VBA.Array( _
        "B", "C", "D", "E", "F", "G", "H", _
        "I", "J", "K", "L", "M", "N", "O", _
        "P", "Q", "R", "S", "T")
    Const DST_FIRST_ROW As Long = 6
    
    ' ???
    Call ParaOff
    Call HideX
    Call SortWorksheets
    
    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Attempt to reference the destination worksheet (instead of the function).
    Dim dws As Worksheet
    On Error Resume Next
        Set dws = wb.Worksheets(wsF)
    On Error GoTo 0
    
    If dws Is Nothing Then
        
        MsgBox "ERROR: Worksheet '" & wsF & "' is missing.", vbCritical
    
    Else
        
        dws.Range("B7:U41", "W7:W41").ClearContents
        
        ' Write the names of the worksheets to be excluded to a dictionary.
        Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
        dict.CompareMode = vbTextCompare
        ' These worksheet names should be in an array.
        dict(wsF) = Empty
        dict(wsG) = Empty
        dict(wsI) = Empty
        dict(wsJ) = Empty
        dict(wsK) = Empty
        
        ' Write the first row to a variable.
        Dim dRow As Long: dRow = DST_FIRST_ROW
        
        Dim sws As Worksheet, sRow As Long, n As Long
        
        For Each sws In wb.Worksheets
            ' Check if it's not a worksheet from the dictionary.
            If Not dict.Exists(sws.Name) Then
                ' Normal case.
                For n = 0 To UBound(sCells)
                    dws.Range(dRow, dCols(n)).Value = sws.Range(sCells(n)).Value
                Next n
                ' ??? Special case.
                sRow = fFindRowByCol(sws.Name, "I", "Div 26*")
                dws.Cells(dRow, "U").Value = sws.Cells(sRow, "P").Value 'DIV 26
                sRow = fFindRowByCol(sws.Name, "I", "Div 32*")
                dws.Cells(dRow, "W").Value = sws.Cells(sRow, "P").Value 'DIV 32
                dRow = dRow + 1 ' increment for the next iteration (worksheet)
            End If
        Next sws
    
    End If
    
    ' ???
    Call ParaOn
    Call Happy

    MsgBox "Summary updated.", vbInformation

End Sub

The Flow

该代码首先为要复制的单元格区域和列定义常数，并清除目标工作表的内容。
然后，它创建一个要从复制过程中排除的工作表名称字典，并循环遍历工作簿中的所有工作表，将指定单元格中的数据复制并粘贴到目标工作表上的相应列中（排除的工作表除外）。
还有两种特殊情况，即数据从源工作表上的特定单元格复制到目标工作表上的特定列。

赞(0）回复(0）举报 2023-04-13

fdbelqdn2#

好吧，但是解决方案，或者答案只是在评论中，没有复选标记作为答案。这里有这么多规则！在这里发布我的问题并获得解决方案是非常有帮助的，也是我学习编码的机会。

赞(0）回复(0）举报 2023-04-13