在 VBA 中的 Array 上运行计算 - 跨列

Question

I would like to loop through each row and count the number of non-contiguous columns with a Yes (AQ, AS, AU,CI, etc). The total count would populate into a separate cell(CL).

I think the array is storing the data correctly, but I am not able to accomplish the correct count within a row.

Sub DynaAtLeastOneSchoolGoalColumnYN()
Dim R As Long, C As Long, J As Long
Dim eNumStorage() As Variant
Dim lrow As Long


With Worksheets("School EOY Data")
lrow = .Cells(Rows.Count, 3).End(xlUp).Row
ReDim eNumStorage(0 - J)

    For R = 3 To 4 'The number of rows in the sheet
        For C = 43 To 87 ' The columns to include
            If .Cells(R, C).Value = "Yes" Then
            For J = LBound(eNumStorage) To UBound(eNumStorage)
                eNumStorage(J) = .Cells(R, C).Value
                Debug.Print eNumStorage(J) & " " & .Cells(R, C).Value & " " & .Cells(1, C).Value & " r = " & R ' this prints all of the columns with a Yes that should be stored in the array.
                
            Next J
            Else
                End If
            C = C + 1
        For J = LBound(eNumStorage) To UBound(eNumStorage)
            eNumStorage(J) = Application.WorksheetFunction.CountA(eNumStorage(J)) 'count all of the values in the array for this row
            'Debug.Print eNumStorage(J) ' would like to print the value 2 for row 3, and the value 1 for row 4
        Next J
            
        Next C

    Next R

End With

End Sub

Answer 1

Count in a Non-Contiguous Range

• CountIf doesn't work with a non-contiguous range, so a loop is required.
• Set rrg = crg.rows(1) doesn't work because it refers to the first area ( crg.Cells(1) ), so Intersect is required ( Set rrg = Intersect(crg, ws.Rows(r)) ).

Option Explicit

Sub DynaAtLeastOneSchoolGoalColumnYN()
    
    ' Define constants.
    Const wsName As String = "School EOY Data"
    Const fRow As Long = 3
    Const lrCol As Long = 3 ' C - the column used to calculate the last row
    Const fCol As Long = 43 ' AQ - incl.
    Const lCol As Long = 88 ' CJ - not incl. (odd columns if 'fcol' is odd)
    Const dCol As Long = 90 ' CL - Destination (Result, Count) Column
    Const Criteria As String = "Yes"
    
    ' Create a reference to the workbook containing this code.
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    ' Create a reference to the worksheet.
    Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
    
    ' Create a reference to the non-contiguous range consisting of multiple
    '  'entire column' (same-sized, vertically same-positioned) ranges.
    Dim crg As Range
    Dim c As Long
    For c = fCol To lCol Step 2 ' every other column
        If crg Is Nothing Then
            Set crg = ws.Columns(c)
        Else
            Set crg = Union(crg, ws.Columns(c))
        End If
    Next c
    
    ' Calculate the last row.
    Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, lrCol).End(xlUp).Row
    
    Dim rrg As Range ' (Current) Row Range
    Dim rCell As Range ' (Current) Cell in Current Row Range
    Dim r As Long ' (Current) Row (Row Counter)
    Dim cCount As Long ' (Current) Criteria Count(er)
    
    ' Loop through the rows...
    For r = fRow To lRow
        ' Create a reference to the Row Range.
        Set rrg = Intersect(crg, ws.Rows(r))
        ' Reset Criteria Counter.
        cCount = 0
        ' Loop through the cells of the Row Range...
        For Each rCell In rrg.Cells
            ' Check cell against the criteria...
            If rCell.Value = Criteria Then
                cCount = cCount + 1
            End If
        Next rCell
        ' Write Criteria Count to (current) Destination Cell.
        ws.Cells(r, dCol).Value = cCount
        'Debug.Print cCount
    Next r

End Sub

EDIT

• The following is a UDF, which you can use in Excel with eg =CountEveryOther(AQ3:CJ3,"Yes") in cell CL3 and then copy down.
• Basically, it counts every occurrence of the criteria in every other cell of the first (intended only) row of a range.

Function CountEveryOther( _
    ByVal SourceRowRange As Range, _
    ByVal Criteria As String) _
As Long
    
    If SourceRowRange Is Nothing Then Exit Function
    
    With SourceRowRange.Rows(1)
        
        Dim fCol As Long: fCol = .Column
        Dim lCol As Long: lCol = .Column + .Columns.Count - 1
        
        Dim crg As Range
        Dim c As Long
        
        For c = fCol To lCol Step 2
            If crg Is Nothing Then
                Set crg = .Cells(1)
            Else
                Set crg = Union(crg, .Cells(c))
            End If
        Next c
        
        Dim cCell As Range
        Dim cCount As Long
    
        For Each cCell In crg.Cells
            If cCell.Value = Criteria Then
                cCount = cCount + 1
            End If
        Next cCell
        
        CountEveryOther = cCount
    
    End With

End Function

Answer 2

I do not understand. I think you want to do something like

Option Explicit
Option Base 1

Private Const YES As String = "Yes"
' TargetColumn = "CL"
Private Const TargetColumn As Long = 90

Public Sub DynaAtLeastOneSchoolGoalColumnYN()
Dim R As Long
Dim C As Long
Dim N As Long
Dim V As Variant

   For R = 3 To 4 Step 1
      N = 0
      
      For C = 43 To 87 Step 1
         V = ThisWorkbook.ActiveSheet.Cells(R, C)
         If (V = YES) Then N = N + 1
      Next
      
      ThisWorkbook.ActiveSheet.Cells(R, TargetColumn) = N
   Next
End Sub