VBA需求：从当前日期列向前统计连续含0单元格数量

Got it, let's work through this VBA task together. Below is a tested solution that will locate the column matching today's date, then count how many consecutive zeros exist when moving left from that column until hitting a non-zero cell.

Key Steps Explained #

• First, we'll scan your header row to find which column corresponds to today's date.
• Once we've pinpointed that column, we'll move left one cell at a time, counting every cell that contains a 0.
• We stop counting as soon as we hit a cell that doesn't have a 0 (or reach the first column of the sheet).

Full VBA Code #

Sub CountConsecutiveZerosLeftOfToday()
    Dim ws As Worksheet
    Dim headerRow As Integer
    Dim todayDate As Date
    Dim targetCol As Integer
    Dim currentCol As Integer
    Dim zeroCount As Integer
    
    ' Update this to your worksheet name
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' Update this to the row where your date headers are located
    headerRow = 1
    
    ' Grab today's date (no time component)
    todayDate = Date
    
    ' Step 1: Locate the column with today's date in the header
    targetCol = 0
    For currentCol = 1 To ws.Cells(headerRow, ws.Columns.Count).End(xlToLeft).Column
        ' Check if the cell contains a valid date that matches today
        If IsDate(ws.Cells(headerRow, currentCol).Value) Then
            If DateValue(ws.Cells(headerRow, currentCol).Value) = todayDate Then
                targetCol = currentCol
                Exit For ' Exit loop once we find the target column
            End If
        End If
    Next currentCol
    
    ' Handle case where today's date isn't found in headers
    If targetCol = 0 Then
        MsgBox "Couldn't find today's date in the header row!", vbExclamation
        Exit Sub
    End If
    
    ' Step 2: Count consecutive zeros moving left from the target column
    zeroCount = 0
    ' Start at target column and move left to column 1
    For currentCol = targetCol To 1 Step -1
        ' Update the row number here to match your data's starting row (e.g., row 2)
        If ws.Cells(2, currentCol).Value = 0 Then
            zeroCount = zeroCount + 1
        Else
            Exit For ' Stop counting when we hit a non-zero value
        End If
    Next currentCol
    
    ' Show the final count
    MsgBox "Consecutive zeros left of today's column: " & zeroCount, vbInformation
End Sub

Customization Tips #

• Worksheet Name: Change "Sheet1" to the actual name of your worksheet.
• Header Row: Adjust headerRow = 1 if your date headers are in a different row (e.g., row 3).
• Data Row: Update ws.Cells(2, currentCol).Value to the row where your numeric data starts.
• Date Format Matching: If your header dates use text-style formats like "May 1st" instead of raw dates, replace the date check with a formatted comparison (adjust the format string to match your header style):

  If Format(ws.Cells(headerRow, currentCol).Value, "mmmm d""st""") = Format(todayDate, "mmmm d""st""") Then
  

内容的提问来源于stack exchange，提问作者bjefko