簡體   English   中英

有沒有更有效的方法來執行此公式的公共子程序?

[英]Is there a more efficient way to execute this public sub for formulas?

我有一個公共子項,該子項可以跨列填充公式(行固定為28行),但是始終只需要自動填充公式,直到行2中的最后一個數據單元格為止。

LastColumn = ThisWorkbook.Worksheets("Profiles").Cells(2, Columns.Count).End(xlToLeft).Column

我有28個公式嵌入到B列中,然后需要在我最終需要的許多列中進行填充,但是必須有一種更有效的方法在for / next循環或case語句中執行此操作,對嗎?

這就是我所擁有的,不是很漂亮。

Public Sub formulas()

    LastColumn = ThisWorkbook.Worksheets("Profiles").Range(2, Columns.Count).End(xlToLeft).Column

    With ThisWorkbook.Worksheets("Profiles")

        .Range("B1").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$M:$M,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B3").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$A:$A,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B4").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$B:$B,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B5").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$F:$F,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B6").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$J:$J,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B7").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$X:$X,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B8").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$G:$G,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B9").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$I:$I,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B10").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$Z:$Z,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B13").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AA:$AA,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B14").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AB:$AB,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B15").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AC:$AC,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B16").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AD:$AD,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B17").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AE:$AE,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B18").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AF:$AF,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B19").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AG:$AG,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B20").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AH:$AH,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B21").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AI:$AI,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B22").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AJ:$AJ,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B23").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AK:$AK,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B24").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AL:$AL,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B25").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AM:$AM,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B26").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AN:$AN,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B27").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AO:$AO,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
        .Range("B28").Formula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!$AP:$AP,MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""

        .Range("B1:B28").FillRight

    End With

End Sub

這是另一種可能性。 我喜歡它的原因是因為它清楚地標識了目標單元格和公式目標之間的映射。

Option Explicit

Sub LoadUpTheFormulas()
    Dim formulaMap As Collection
    Set formulaMap = New Collection

    With formulaMap
        .Add "B1,$M:$M"
        .Add "B3,$A:$A"
        .Add "B4,$B:$B"
        .Add "B5,$F:$F"
        '  ... 
    End With

    With ThisWorkbook.Worksheets("Profiles")
        Dim lastColumn As Long
        lastColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column

        Dim map As Variant
        For Each map In formulaMap
            Dim parts As Variant
            Dim theRange As Range
            Dim theFormula As String
            parts = Split(map, ",")
            Set theRange = .Range(parts(0))
            theFormula = "=IFNA(INDEX(CM_JOB_PROFILE_EXCEL!" & parts(1) & _
                         ",MATCH(B$2,CM_JOB_PROFILE_EXCEL!$A:$A,0)),"""") & """""
            theRange.Formula = theFormula
            theRange.AutoFill Destination:=theRange.Resize(1, lastColumn)
        Next map
    End With
End Sub

未經測試,我幾乎可以肯定將引號放錯了位置,因此您需要仔細檢查生成的公式字符串是否有效/正確,但這就是我在上面的評論中提到的想法:

您有非順序迭代(1、3、4-10、13-28),它似乎與在Index函數中搜索的數組沒有任何直接明顯的關系,因此可以排除字典迭代。 您可以CONST一些字符串文字,這將使維護更加容易(因為您只需要在一個地方更新工作表名稱"CM_JOB_PROFILE_EXCEL""CM_JOB_PROFILE_EXCEL"

Option Explicit

Public Sub formulas()
Const SHEET_NAME$ = "CM_JOB_PROFILE_EXCEL"
Const MATCH_OPEN$ = "MATCH(B$2,"
Const IFINDEX_OPEN$ = "=IFNA(INDEX("

Dim LastColumn As Long
Dim formulaOpen$
Dim matchFormula$
Dim formulaClose$

LastColumn = ThisWorkbook.Worksheets("Profiles").Cells(2, Columns.Count).End(xlToLeft).Column

formulaOpen = IFINDEX_OPEN & SHEET_NAME & "!"
matchFormula = MATCH_OPEN & "," & SHEET_NAME & "!$A:$A,0)"
formulaClose = "),"""") & """""

    With ThisWorkbook.Worksheets("Profiles")

        .Cells(1, 2 & LastColumn).Formula = formulaOpen & "$M:$M," & matchFormula & formulaClose
        .Cells(3, 2 & LastColumn).Formula = formulaOpen & "$A:$A," & matchFormula & formulaClose
        .Cells(4, 2 & LastColumn).Formula = formulaOpen & "$B:$B," & matchFormula & formulaClose
        .Cells(5, 2 & LastColumn).Formula = formulaOpen & "$F:$F," & matchFormula & formulaClose
        .Cells(6, 2 & LastColumn).Formula = formulaOpen & "$J:$J," & matchFormula & formulaClose
        .Cells(7, 2 & LastColumn).Formula = formulaOpen & "$X:$X," & matchFormula & formulaClose
        .Cells(8, 2 & LastColumn).Formula = formulaOpen & "$G:$X," & matchFormula & formulaClose
        .Cells(9, 2 & LastColumn).Formula = formulaOpen & "$I:$I," & matchFormula & formulaClose
        .Cells(10, 2 & LastColumn).Formula = formulaOpen & "$Z:$Z," & matchFormula & formulaClose
        .Cells(13, 2 & LastColumn).Formula = formulaOpen & "$AA:$AA," & matchFormula & formulaClose
        .Cells(14, 2 & LastColumn).Formula = formulaOpen & "$AB:$AB," & matchFormula & formulaClose
        .Cells(15, 2 & LastColumn).Formula = formulaOpen & "$AC:$C," & matchFormula & formulaClose
        .Cells(16, 2 & LastColumn).Formula = formulaOpen & "$AD:$AD," & matchFormula & formulaClose
        .Cells(17, 2 & LastColumn).Formula = formulaOpen & "$AE:$AE," & matchFormula & formulaClose
        .Cells(18, 2 & LastColumn).Formula = formulaOpen & "$AF:$AF," & matchFormula & formulaClose
        .Cells(19, 2 & LastColumn).Formula = formulaOpen & "$AG:$AG," & matchFormula & formulaClose
        .Cells(20, 2 & LastColumn).Formula = formulaOpen & "$AH:$AH," & matchFormula & formulaClose
        .Cells(21, 2 & LastColumn).Formula = formulaOpen & "$AI:$AI," & matchFormula & formulaClose
        .Cells(22, 2 & LastColumn).Formula = formulaOpen & "$AJ:$AJ," & matchFormula & formulaClose
        .Cells(23, 2 & LastColumn).Formula = formulaOpen & "$AK:$AK," & matchFormula & formulaClose
        .Cells(24, 2 & LastColumn).Formula = formulaOpen & "$AL:$AL," & matchFormula & formulaClose
        .Cells(25, 2 & LastColumn).Formula = formulaOpen & "$AM:$AM," & matchFormula & formulaClose
        .Cells(26, 2 & LastColumn).Formula = formulaOpen & "$AN:$AN," & matchFormula & formulaClose
        .Cells(27, 2 & LastColumn).Formula = formulaOpen & "$AO:$AO," & matchFormula & formulaClose
        .Cells(28, 2 & LastColumn).Formula = formulaOpen & "$AP:$AP," & matchFormula & formulaClose

    End With

End Sub

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM