VBA子程序开发求助：多变量CountIf统计及Statistics工作表管理

Got it, let's combine all your requirements into one clean VBA subroutine. I'll include comments in the code and break down each part so you can adjust it to your specific data ranges and variables.

Complete Code #

Sub GenerateStatistics()
    Dim wsData As Worksheet
    Dim wsStats As Worksheet
    Dim statsRange As Range
    Dim criteriaList As Variant
    Dim resultsArray As Variant
    Dim i As Integer
    Dim sheetExists As Boolean
    
    ' Set the worksheet containing your data (adjust this to your actual sheet name)
    Set wsData = ThisWorkbook.Worksheets("Data")
    
    ' Define your criteria and the range to count (customize these to your needs)
    ' Example: counting occurrences of "High", "Medium", "Low" in column B
    criteriaList = Array("High", "Medium", "Low")
    Set statsRange = wsData.Range("B:B") ' Range to perform CountIf on
    
    ' Initialize array to store results
    ReDim resultsArray(1 To UBound(criteriaList) + 1, 1 To 2)
    
    ' Populate headers in results array
    resultsArray(1, 1) = "Variable"
    resultsArray(1, 2) = "Count"
    
    ' Perform CountIf for each criteria and store results
    For i = LBound(criteriaList) To UBound(criteriaList)
        resultsArray(i + 2, 1) = criteriaList(i)
        resultsArray(i + 2, 2) = Application.WorksheetFunction.CountIf(statsRange, criteriaList(i))
    Next i
    
    ' Check if "Statistics" sheet exists
    sheetExists = False
    For Each wsStats In ThisWorkbook.Worksheets
        If wsStats.Name = "Statistics" Then
            sheetExists = True
            Exit For
        End If
    Next wsStats
    
    ' Handle existing sheet or create new one
    If sheetExists Then
        ' Prompt user for overwrite confirmation
        If MsgBox("Do you want to overwrite the existing 'Statistics' sheet?", vbYesNo + vbQuestion, "Overwrite Confirmation") = vbNo Then
            Exit Sub ' Exit if user chooses not to overwrite
        Else
            ' Clear existing data in the sheet (keep formatting if needed, or use .Cells.Clear)
            wsStats.Cells.ClearContents
        End If
    Else
        ' Create new "Statistics" sheet
        Set wsStats = ThisWorkbook.Worksheets.Add
        wsStats.Name = "Statistics"
    End If
    
    ' Write the results to the Statistics sheet
    wsStats.Range("A1").Resize(UBound(resultsArray, 1), UBound(resultsArray, 2)).Value = resultsArray
    
    ' Optional: Format the header row for better readability
    With wsStats.Range("A1:B1")
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
    End With
    
    ' Auto-fit columns to fit content
    wsStats.Columns("A:B").AutoFit
    
    MsgBox "Statistics generated successfully!", vbInformation, "Complete"
End Sub

Key Parts Explained #

• Data Collection: We first define the data sheet and the criteria we want to count. The criteriaList array holds your variables, and statsRange is where we'll perform the CountIf checks. Adjust these to match your actual data.
• CountIf Execution: A loop runs through each criteria, uses Application.WorksheetFunction.CountIf to get the count, and stores everything in an array for easy writing later (this is more efficient than writing cell-by-cell).
• Sheet Existence Check: We loop through all worksheets to see if "Statistics" already exists. This avoids errors from trying to create a duplicate sheet.
• Overwrite Prompt: If the sheet exists, we show a yes/no dialog. If the user selects "No", the sub exits without making changes. If "Yes", we clear the existing content (you can modify this to clear formatting too if needed).
• Writing Results: The results array is written to the sheet in one go, and we add some basic formatting to make the output clean and readable.

Customization Tips #

• Change wsData = ThisWorkbook.Worksheets("Data") to your actual data sheet name.
• Update criteriaList with your specific variables (e.g., Array("Product X", "Product Y", "Product Z")).
• Adjust statsRange to the exact column/range where your target data lives (e.g., wsData.Range("D2:D1000") to avoid counting empty cells at the bottom of the column).

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