VBA Macro Vlookup and Index Match function for dynamic number of sheet

Question

我使用宏通過手動記錄來運行索引匹配和 vlookup 函數。 問題是紙張目標並不總是可用，有時只有 3 或 5 張，所以它完全隨機

這是我使用的代碼

Sub Function()

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False

'COA
Sheets(2).Range("A6").FormulaR1C1 = _
"=IFERROR(INDEX('ACF'!R6C:R2000C,MATCH(RC3,'ACF'!R6C3:R2000C3,0)),IFERROR(INDEX('ACF'!R6C:R2000C,MATCH(RC3,'ACF'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('BIGBIKE'!R6C:R2000C,MATCH(RC3,'BIGBIKE'!R6C3:R2000C3,0)),IFERROR(INDEX('BIGBIKE'!R6C:R2000C,MATCH(RC3,'BIGBIKE'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('BOD'!R6C:R2000C,MATCH(RC3,'BOD'!R6C3:R2000C3,0)),IFERROR(INDEX('BOD'!R6C:R2000C,MATCH(RC3,'BOD'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('CORPSEC'!R6C:R2000C,MATCH(RC3,'CORPSEC'!R6C3:R2000C3,0)),IFERROR(INDEX('CORPSEC'!R6C:R2000C,MATCH(RC3,'CORPSEC'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('DIGITAL'!R6C:R2000C,MATCH(RC3,'DIGITAL'!R6C3:R2000C3,0)),IFERROR(INDEX('DIGITAL'!R6C:R2000C,MATCH(RC3,'DIGITAL'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('GDG'!R6C:R2000C,MATCH(RC3,'GDG'!R6C3:R2000C3,0)),IFERROR(INDEX('GDG'!R6C:R2000C,MATCH(RC3,'GDG'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('HC3'!R6C:R2000C,MATCH(RC3,'HC3'!R6C3:R2000C3,0)),IFERROR(INDEX('HC3'!R6C:R2000C,MATCH(RC3,'HC3'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('HRGA'!R6C:R2000C,MATCH(RC3,'HRGA'!R6C3:R2000C3,0)),IFERROR(INDEX('HRGA'!R6C:R2000C,MATCH(RC3,'HRGA'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('IT'!R6C:R2000C,MATCH(RC3,'IT'!R6C3:R2000C3,0)),IFERROR(INDEX('IT'!R6C:R2000C,MATCH(RC3,'IT'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('LDD'!R6C:R2000C,MATCH(RC3,'LDD'!R6C3:R2000C3,0)),IFERROR(INDEX('LDD'!R6C:R2000C,MATCH(RC3,'LDD'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('MCD'!R6C:R2000C,MATCH(RC3,'MCD'!R6C3:R2000C3,0)),IFERROR(INDEX('MCD'!R6C:R2000C,MATCH(RC3,'MCD'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('MSD'!R6C:R2000C,MATCH(RC3,'MSD'!R6C3:R2000C3,0)),IFERROR(INDEX('MSD'!R6C:R2000C,MATCH(RC3,'MSD'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('NPD'!R6C:R2000C,MATCH(RC3,'NPD'!R6C3:R2000C3,0)),IFERROR(INDEX('NPD'!R6C:R2000C,MATCH(RC3,'NPD'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('PARTS'!R6C:R2000C,MATCH(RC3,'PARTS'!R6C3:R2000C3,0)),IFERROR(INDEX('PARTS'!R6C:R2000C,MATCH(RC3,'PARTS'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('PURCHASING'!R6C:R2000C,MATCH(RC3,'PURCHASING'!R6C3:R2000C3,0)),IFERROR(INDEX('PURCHASING'!R6C:R2000C,MATCH(RC3,'PURCHASING'!R6C5:R2000C5,0))" & _
",IFERROR(INDEX('TSD'!R6C:R2000C,MATCH(RC3,'TSD'!R6C3:R2000C3,0)),INDEX('TSD'!R6C:R2000C,MATCH(RC3,'TSD'!R6C5:R2000C5,0))" & _
")))))))))))))))))))))))))))))))"

Application.AskToUpdateLinks = True
Application.DisplayAlerts = True

Application.AskToUpdateLinks = False
Application.DisplayAlerts = False

'Status
Sheets(2).Range("D6").FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC3,'ACF'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'ACF'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'BIGBIKE'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'BIGBIKE'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'BOD'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'BOD'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'CORPSEC'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'CORPSEC'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'DIGITAL'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'DIGITAL'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'GDG'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'GDG'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'HC3'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'HC3'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'HRGA'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'HRGA'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'IT'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'IT'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'LDD'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'LDD'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'MCD'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'MCD'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'MSD'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'MSD'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'NPD'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'NPD'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'PARTS'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'PARTS'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'PURCHASING'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'PURCHASING'!R6C5:R2000C12,2,0)" & _
",IFERROR(VLOOKUP(RC3,'TSD'!R6C3:R2000C12,4,0),VLOOKUP(RC3,'TSD'!R6C5:R2000C12,2,0)" & _
")))))))))))))))))))))))))))))))"

Application.AskToUpdateLinks = True
Application.DisplayAlerts = True

end sub

有沒有辦法讓公式只運行工作簿上可用的工作表？ 因為如果我按原樣運行它，它總是要求更新工作簿上不可用的工作表的公式。

Answer 1

您必須遍歷工作簿中的工作表。

Sub insertCOAandStatusFormulas()

'Pattern of each formula part - $1 as placeholder for sheetname

Dim strPartCOA As String, strPartStatus As String
strPartCOA = "IFERROR(INDEX('$1'!R6C:R2000C,MATCH(RC3,'$1'!R6C3:R2000C3,0)),IFERROR(INDEX('$1'!R6C:R2000C,MATCH(RC3,'$1'!R6C5:R2000C5,0)), "
strPartStatus = "IFERROR(VLOOKUP(RC3,'$1'!R6C3:R2000C12,4,0),IFERROR(VLOOKUP(RC3,'$1'!R6C5:R2000C12,2,0), "


Dim wsTarget As Worksheet
Set wsTarget = ThisWorkbook.Worksheets("Tabelle1")    '--> adjust this to your needs


'build sheet-specific part per formula
Dim strFormulaCOA As String, strFormulaStatus As String
Dim cntSheets As Long, i As Long

Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> wsTarget.Name Then
        strFormulaCOA = strFormulaCOA & Replace(strPartCOA, "$1", ws.Name) & vbCrLf
        strFormulaStatus = strFormulaStatus & Replace(strPartStatus, "$1", ws.Name) & vbCrLf
        cntSheets = cntSheets + 1
    End If
Next

'add equal-sign, remove last comma and add closing brackets
If LenB(strFormulaCOA) > 0 Then

    'XXXX this part is not working XXXX - you would have to find out, how many brackets you have to add and at which position they have to go
    strFormulaCOA = "=" & Left(strFormulaCOA, Len(strFormulaCOA) - 4) & ", ""no value found""" & String((cntSheets * 2), ")")
    strFormulaStatus = "=" & Left(strFormulaStatus, Len(strFormulaStatus) - 4) & ", ""no value found""" & String((cntSheets + 2) + 1, ")")
    
    With wsTarget
        .Range("A6").FormulaR1C1 = strFormulaCOA
        .Range("D6").FormulaR1C1 = strFormulaStatus
    End With
End If

End Sub

您必須對括號進行調整 - 請參閱代碼中的注釋