VBA COUNTIFs 公式，用于引用另一个工作表中的动态范围

VBA 写入公式COUNTIFS

Option Explicit

Sub WriteCOUNTIFS()
    
    ' =IF(COUNTIFS(TPR!$B$5:$B$10,Compiled!$A2,
    '  TPR!$A$5:$A$10,Compiled!H$1)>0,"Yes","")
    
    Const sName As String = "TPR"
    Const shCol As String = "A"
    Const svCol As String = "B"
    Const sfRow As Long = 5
    
    Const dName As String = "COMPILED"
    Const dlrCol As String = "A"
    Const dCols As String = "H:AA"
    Const dfRow As Long = 2
    
    Dim sws As Worksheet: Set sws = ThisWorkbook.Worksheets(sName)
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    Dim srCount As Long: srCount = slRow - sfRow + 1
    Dim shcrg As Range
    Set shcrg = sws.Cells(sfRow, shCol).Resize(srCount)
    Dim shAddress As String: shAddress = "'" & sName & "'!" & shcrg.Address
    Dim svcrg As Range: Set svcrg = shcrg.EntireRow.Columns(svCol)
    Dim svAddress As String: svAddress = "'" & sName & "'!" & svcrg.Address
    
    
    Dim dws As Worksheet: Set dws = ThisWorkbook.Worksheets(dName)
    Dim dhrrg As Range: Set dhrrg = dws.Columns(dCols).Rows(1)
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, dlrCol).End(xlUp).Row
    Dim drCount As Long: drCount = dlRow - dfRow + 1
    Dim drg As Range
    Set drg = dws.Columns(dCols).Resize(drCount).Offset(dfRow - 1)
    Dim dhAddress As String: dhAddress = dhrrg.Cells(1).Address(, 0)
    Dim dvAddress As String: dvAddress = dws.Cells(dfRow, dlrCol).Address(0)
    
    drg.Formula = "=IF(COUNTIFS(" & svAddress _
        & "," & dvAddress & "," & shAddress & "," & dhAddress _
        & ")>0,""Yes"","""")"

    'Debug.Print svAddress, dvAddress
    'Debug.Print shAddress, dhAddress

End Sub