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

Question

我正在尝试通过 VBA 将 COUNTIFS 公式合并到工作表中 - 我的公式工作正常，但它不是动态的，而且由于我相当有限的 VBA 技能，我遇到了一些困难。

为了解释一下，COUNTIFS 查看 COMPILED 工作表中的 19 个不同标题(从 H1 到 AA1)，并计算 TPR 工作表中某个范围内"is"的出现次数 - 正是这个范围需要保持活力。

这是我当前使用的 VBA 公式，效果很好，但正如前面提到的，它是一个固定范围:

'Add in COUNTIFS formulas
     With Sheets("COMPILED")
        .Range("H2:AA" & .Cells(.Rows.Count, "A").End(xlUp).Row).FormulaR1C1 = "=IF(COUNTIFS(TPR!R5C2:R20000C2,COMPILED!RC1,TPR!R5C1:R20000C1,COMPILED!R1C)>0,""Yes"","""")"
     End With

非常感谢和最诚挚的问候， TE

Answer 1

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