动态文本Join与另一个工作簿中的条件查找VBA查找

Question

如何使用VBA代码进行动态文本Join，并从另一个工作簿中查找条件？

我想将此公式转换为vba：

= textjoin（“，”，true，if（$ c $ 15 = [export.xlsx] sheet1！$ e $ 2：$ e $ 13047，[export.xlsx] sheet1！ $ 2：$ a $ 13047，“”））

当前这是我到目前为止所做的VBA代码，并且正在弹出错误，说明“运行时错误'91'：对象变量或block变量未设置”

Sub join()

Dim exportWb As Workbook
Dim exportWs As Worksheet
Set exportWs = exportWb.Sheets("Sheet1")

Workbooks.Open ("C:\Users\desktop\export.xlsx")
Set exportWb = ActiveWorkbook
ThisWorkbook.Activate

Dim exportlastRow1 As Range
Dim exportlastRow2 As Range

exportlastRow1 = exportWs.Cells(exportWs.Rows.Count, "A").End(xlUp).Row
exportlastRow2 = exportWs.Cells(exportWs.Rows.Count, "E").End(xlUp).Row

Dim existSAPID As String
existSAPID = ActiveSheet.Evaluate("TEXTJOIN(", ",TRUE,IF(C15 = 
exportlastRow2,exportlastRow1,""))")

End Sub

Answer 1

VBA代码的公式

Sub JoinMatches()

    ' Source
    Const sFilePath As String = "C:\Test\T2022\72284158\export.xlsx"
    Const sName As String = "Sheet1"
    Const sLookupFirstCellAddress As String = "E2"
    Const sJoinColumn As String = "A"
    ' Destination
    Const dName As String = "Credit Assessment"
    Const dLookupCellAddress As String = "C15"
    Const dJoinCellAddress As String = "C10"
    
    ' Reference the source (lookup and join) ranges.
    
    Dim sFileName As String: sFileName = Dir(sFilePath)
    If Len(sFileName) = 0 Then
        MsgBox "The file '" & sFilePath & "' doesn't exist.", vbCritical
        Exit Sub
    End If
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFilePath)
    Dim sws As Worksheet: Set sws = swb.Worksheets(sName)
    
    Dim slrg As Range
    Dim sjrg As Range
    
    With sws.Range(sLookupFirstCellAddress)
        
        Dim lCell As Range
        Set lCell = .Resize(sws.Rows.Count - .Row + 1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If lCell Is Nothing Then
            MsgBox "No data in column range.", vbCritical
            Exit Sub
        End If
        
        Set slrg = .Resize(lCell.Row - .Row + 1)
        Set sjrg = slrg.EntireRow.Columns(sJoinColumn)
    
    End With
    
    ' Reference the destination join cell.
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    Dim djCell As Range: Set djCell = dws.Range(dJoinCellAddress)
    
    ' Evaluate.
    djCell.Value _
        = dws.Evaluate("TEXTJOIN("", "",TRUE,IF(" & dLookupCellAddress _
        & "='[" & sFileName & "]" & sName & "'!" & slrg.Address _
        & ",'[" & sFileName & "]" & sName & "'!" & sjrg.Address & ",""""))")
    
    ' Close.
    'swb.Close SaveChanges:=False
    
    ' Inform.
    MsgBox "Data joined.", vbInformation

End Sub