[英]Excel VBA: More efficient way to compare values with formulas for large range
[英]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.