我正在尝试创建一个堆叠柱状图(与我之前的问题相同)。当我尝试将日期变量设置为电子表格中的日期时，我现在遇到了下标超出范围错误。
这是发生错误的for循环的开始:
For b = 2 To 255
DDate = ThisWorkbook("Query Results.xlsm").Worksheets("Macros Test Sheet").Cells(b, 3).Value
DDate就是用这个错误高亮显示的那行。实际上，我的C列以m/dd/yyyy的格式有一堆日期。我创建了一个for循环来遍历C列中的每一行，并将DDate变量设置为该日期。然后，我有if语句来根据月份提取某些信息。在上面的行中，我将DDate声明为日期。下面是我的代码，这样你就可以看到我在说什么(大部分都是重复的)。
Sub SecondaryInterimTracker()
Dim DDate As Date
Dim MonthNum As Integer
Dim human As String
human = "Human"
Dim method As String
method = "Method/Procedure"
Dim equipment As String
equipment = "Equipment"
Dim material As String
material = "Material"
Dim environment As String
environment = "Environment"
Dim JanHuman As Single
Dim JanMethod As Single
Dim JanEquipment As Single
Dim JanMaterial As Single
Dim JanEnvironment As Single
Dim JanUnknown As Single
JanHuman = 0
JanMethod = 0
JanEquipment = 0
JanMaterial = 0
JanEnvironment = 0
JanUnknown = 0
Dim FebHuman As Single
Dim FebMethod As Single
Dim FebEquipment As Single
Dim FebMaterial As Single
Dim FebEnvironment As Single
Dim FebUnknown As Single
FebHuman = 0
FebMethod = 0
FebEquipment = 0
FebMaterial = 0
FebEnvironment = 0
FebUnknown = 0
Dim MarHuman As Single
Dim MarMethod As Single
Dim MarEquipment As Single
Dim MarMaterial As Single
Dim MarEnvironment As Single
Dim MarUnknown As Single
MarHuman = 0
MarMethod = 0
MarEquipment = 0
MarMaterial = 0
MarEnvironment = 0
MarUnknown = 0
Dim AprHuman As Single
Dim AprMethod As Single
Dim AprEquipment As Single
Dim AprMaterial As Single
Dim AprEnvironment As Single
Dim AprUnknown As Single
AprHuman = 0
AprMethod = 0
AprEquipment = 0
AprMaterial = 0
AprEnvironment = 0
AprUnknown = 0
Dim MayHuman As Single
Dim MayMethod As Single
Dim MayEquipment As Single
Dim MayMaterial As Single
Dim MayEnvironment As Single
Dim MayUnknown As Single
MayHuman = 0
MayMethod = 0
MayEquipment = 0
MayMaterial = 0
MayEnvironment = 0
MayUnknown = 0
Dim JunHuman As Single
Dim JunMethod As Single
Dim JunEquipment As Single
Dim JunMaterial As Single
Dim JunEnvironment As Single
Dim JunUnknown As Single
JunHuman = 0
JunMethod = 0
JunEquipment = 0
JunMaterial = 0
JunEnvironment = 0
JunUnknown = 0
Dim JulHuman As Single
Dim JulMethod As Single
Dim JulEquipment As Single
Dim JulMaterial As Single
Dim JulEnvironment As Single
Dim JulUnknown As Single
JulHuman = 0
JulMethod = 0
JulEquipment = 0
JulMaterial = 0
JulEnvironment = 0
JulUnknown = 0
Dim AugHuman As Single
Dim AugMethod As Single
Dim AugEquipment As Single
Dim AugMaterial As Single
Dim AugEnvironment As Single
Dim AugUnknown As Single
AugHuman = 0
AugMethod = 0
AugEquipment = 0
AugMaterial = 0
AugEnvironment = 0
AugUnknown = 0
Dim SepHuman As Single
Dim SepMethod As Single
Dim SepEquipment As Single
Dim SepMaterial As Single
Dim SepEnvironment As Single
Dim SepUnknown As Single
SepHuman = 0
SepMethod = 0
SepEquipment = 0
SepMaterial = 0
SepEnvironment = 0
SepUnknown = 0
Dim OctHuman As Single
Dim OctMethod As Single
Dim OctEquipment As Single
Dim OctMaterial As Single
Dim OctEnvironment As Single
Dim OctUnknown As Single
OctHuman = 0
OctMethod = 0
OctEquipment = 0
OctMaterial = 0
OctEnvironment = 0
OctUnknown = 0
Dim NovHuman As Single
Dim NovMethod As Single
Dim NovEquipment As Single
Dim NovMaterial As Single
Dim NovEnvironment As Single
Dim NovUnknown As Single
NovHuman = 0
NovMethod = 0
NovEquipment = 0
NovMaterial = 0
NovEnvironment = 0
NovUnknown = 0
Dim DecHuman As Single
Dim DecMethod As Single
Dim DecEquipment As Single
Dim DecMaterial As Single
Dim DecEnvironment As Single
Dim DecUnknown As Single
DecHuman = 0
DecMethod = 0
DecEquipment = 0
DecMaterial = 0
DecEnvironment = 0
DecUnknown = 0
For b = 2 To 255
DDate = Workbooks("Query Results.xlsm").Worksheets("Macros Test Sheet").Cells(b, 3).Value
MonthNum = Month(DDate)
If MonthNum = 1 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
JanHuman = JanHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
JanMethod = JanMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
JanEquipment = JanEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
JanMaterial = JanMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
JanEnvironment = JanEnvironment + 1
Else
JanUnknown = JanUnknown + 1
End If
ElseIf MonthNum = 2 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
FebHuman = FebHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
FebMethod = FebMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
FebEquipment = FebEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
FebMaterial = FebMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
FebEnvironment = FebEnvironment + 1
Else
FebUnknown = FebUnknown + 1
End If
ElseIf MonthNum = 3 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
MarHuman = MarHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
MarMethod = MarMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
MarEquipment = MarEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
MarMaterial = MarMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
MarEnvironment = MarEnvironment + 1
Else
MarUnknown = MarUnknown + 1
End If
ElseIf MonthNum = 4 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
AprHuman = AprHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
AprMethod = AprMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
AprEquipment = AprEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
AprMaterial = AprMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
AprEnvironment = AprEnvironment + 1
Else
AprUnknown = AprUnknown + 1
End If
ElseIf MonthNum = 5 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
MayHuman = MayHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
MayMethod = MayMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
MayEquipment = MayEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
MayMaterial = MayMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
MayEnvironment = MayEnvironment + 1
Else
MayUnknown = MayUnknown + 1
End If
ElseIf MonthNum = 6 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
JunHuman = JunHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
JunMethod = JunMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
JunEquipment = JunEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
JunMaterial = JunMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
JunEnvironment = JunEnvironment + 1
Else
JunUnknown = JunUnknown + 1
End If
ElseIf MonthNum = 7 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
JulHuman = JulHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
JulMethod = JulMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
JulEquipment = JulEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
JulMaterial = JulMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
JulEnvironment = JulEnvironment + 1
Else
JulUnknown = JulUnknown + 1
End If
ElseIf MonthNum = 8 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
AugHuman = AugHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
AugMethod = AugMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
AugEquipment = AugEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
AugMaterial = AugMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
AugEnvironment = AugEnvironment + 1
Else
AugUnknown = AugUnknown + 1
End If
ElseIf MonthNum = 9 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
SepHuman = SepHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
SepMethod = SepMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
SepEquipment = SepEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
SepMaterial = SepMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
SepEnvironment = SepEnvironment + 1
Else
SepUnknown = SepUnknown + 1
End If
ElseIf MonthNum = 10 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
OctHuman = OctHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
OctMethod = OctMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
OctEquipment = OctEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
OctMaterial = OctMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
OctEnvironment = OctEnvironment + 1
Else
OctUnknown = OctUnknown + 1
End If
ElseIf MonthNum = 11 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
NovHuman = NovHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
NovMethod = NovMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
NovEquipment = NovEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
NovMaterial = NovMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
NovEnvironment = NovEnvironment + 1
Else
NovUnknown = NovUnknown + 1
End If
ElseIf MonthNum = 12 Then
If Worksheets("Macros Test Sheet").Cells(b, 8).Value = human Then
DecHuman = DecHuman + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = method Then
DecMethod = DecMethod + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = equipment Then
DecEquipment = DecEquipment + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = material Then
DecMaterial = DecMaterial + 1
ElseIf Worksheets("Macros Test Sheet").Cells(b, 8).Value = environment Then
DecEnvironment = DecEnvironment + 1
Else
DecUnknown = DecUnknown + 1
End If
End If
Next b
Worksheets("Hidden Sheet").Visible = False
Dim january As String
january = "January"
Dim february As String
february = "February"
Dim march As String
march = "March"
Dim april As String
april = "April"
Dim may As String
may = "May"
Dim june As String
june = "June"
Dim july As String
july = "July"
Dim august As String
august = "August"
Dim september As String
september = "September"
Dim october As String
october = "October"
Dim november As String
november = "November"
Dim december As String
december = "December"
Dim x As String
x = "X"
Dim y As String
y = "Human"
Dim yy As String
yy = "Method"
Dim yyy As String
yyy = "Equipment"
Dim yyyy As String
yyyy = "Material"
Dim yyyyy As String
yyyyy = "Environment"
Dim yyyyyy As String
yyyyyy = "Unknown"
Worksheets("Hidden Sheet").Cells(3, 1).Value = x
Worksheets("Hidden Sheet").Cells(3, 2).Value = y
Worksheets("Hidden Sheet").Cells(3, 3).Value = yy
Worksheets("Hidden Sheet").Cells(3, 4).Value = yyy
Worksheets("Hidden Sheet").Cells(3, 5).Value = yyyy
Worksheets("Hidden Sheet").Cells(3, 6).Value = yyyyy
Worksheets("Hidden Sheet").Cells(3, 7).Value = yyyyyy
Worksheets("Hidden Sheet").Cells(4, 1).Value = january
Worksheets("Hidden Sheet").Cells(5, 1).Value = february
Worksheets("Hidden Sheet").Cells(6, 1).Value = march
Worksheets("Hidden Sheet").Cells(7, 1).Value = april
Worksheets("Hidden Sheet").Cells(8, 1).Value = may
Worksheets("Hidden Sheet").Cells(9, 1).Value = june
Worksheets("Hidden Sheet").Cells(10, 1).Value = july
Worksheets("Hidden Sheet").Cells(11, 1).Value = august
Worksheets("Hidden Sheet").Cells(12, 1).Value = september
Worksheets("Hidden Sheet").Cells(13, 1).Value = october
Worksheets("Hidden Sheet").Cells(14, 1).Value = november
Worksheets("Hidden Sheet").Cells(15, 1).Value = december
Worksheets("Hidden Sheet").Cells(4, 2).Value = JanHuman
Worksheets("Hidden Sheet").Cells(5, 2).Value = FebHuman
Worksheets("Hidden Sheet").Cells(6, 2).Value = MarHuman
Worksheets("Hidden Sheet").Cells(7, 2).Value = AprHuman
Worksheets("Hidden Sheet").Cells(8, 2).Value = MayHuman
Worksheets("Hidden Sheet").Cells(9, 2).Value = JunHuman
Worksheets("Hidden Sheet").Cells(10, 2).Value = JulHuman
Worksheets("Hidden Sheet").Cells(11, 2).Value = AugHuman
Worksheets("Hidden Sheet").Cells(12, 2).Value = SepHuman
Worksheets("Hidden Sheet").Cells(13, 2).Value = OctHuman
Worksheets("Hidden Sheet").Cells(14, 2).Value = NovHuman
Worksheets("Hidden Sheet").Cells(15, 2).Value = DecHuman
Worksheets("Hidden Sheet").Cells(4, 3).Value = JanMethod
Worksheets("Hidden Sheet").Cells(5, 3).Value = FebMethod
Worksheets("Hidden Sheet").Cells(6, 3).Value = MarMethod
Worksheets("Hidden Sheet").Cells(7, 3).Value = AprMethod
Worksheets("Hidden Sheet").Cells(8, 3).Value = MayMethod
Worksheets("Hidden Sheet").Cells(9, 3).Value = JunMethod
Worksheets("Hidden Sheet").Cells(10, 3).Value = JulMethod
Worksheets("Hidden Sheet").Cells(11, 3).Value = AugMethod
Worksheets("Hidden Sheet").Cells(12, 3).Value = SepMethod
Worksheets("Hidden Sheet").Cells(13, 3).Value = OctMethod
Worksheets("Hidden Sheet").Cells(14, 3).Value = NovMethod
Worksheets("Hidden Sheet").Cells(15, 3).Value = DecMethod
Worksheets("Hidden Sheet").Cells(4, 4).Value = JanEquipment
Worksheets("Hidden Sheet").Cells(5, 4).Value = FebEquipment
Worksheets("Hidden Sheet").Cells(6, 4).Value = MarEquipment
Worksheets("Hidden Sheet").Cells(7, 4).Value = AprEquipment
Worksheets("Hidden Sheet").Cells(8, 4).Value = MayEquipment
Worksheets("Hidden Sheet").Cells(9, 4).Value = JunEquipment
Worksheets("Hidden Sheet").Cells(10, 4).Value = JulEquipment
Worksheets("Hidden Sheet").Cells(11, 4).Value = AugEquipment
Worksheets("Hidden Sheet").Cells(12, 4).Value = SepEquipment
Worksheets("Hidden Sheet").Cells(13, 4).Value = OctEquipment
Worksheets("Hidden Sheet").Cells(14, 4).Value = NovEquipment
Worksheets("Hidden Sheet").Cells(15, 4).Value = DecEquipment
Worksheets("Hidden Sheet").Cells(4, 5).Value = JanMaterial
Worksheets("Hidden Sheet").Cells(5, 5).Value = FebMaterial
Worksheets("Hidden Sheet").Cells(6, 5).Value = MarMaterial
Worksheets("Hidden Sheet").Cells(7, 5).Value = AprMaterial
Worksheets("Hidden Sheet").Cells(8, 5).Value = MayMaterial
Worksheets("Hidden Sheet").Cells(9, 5).Value = JunMaterial
Worksheets("Hidden Sheet").Cells(10, 5).Value = JulMaterial
Worksheets("Hidden Sheet").Cells(11, 5).Value = AugMaterial
Worksheets("Hidden Sheet").Cells(12, 5).Value = SepMaterial
Worksheets("Hidden Sheet").Cells(13, 5).Value = OctMaterial
Worksheets("Hidden Sheet").Cells(14, 5).Value = NovMaterial
Worksheets("Hidden Sheet").Cells(15, 5).Value = DecMaterial
Worksheets("Hidden Sheet").Cells(4, 6).Value = JanEnvironment
Worksheets("Hidden Sheet").Cells(5, 6).Value = FebEnvironment
Worksheets("Hidden Sheet").Cells(6, 6).Value = MarEnvironment
Worksheets("Hidden Sheet").Cells(7, 6).Value = AprEnvironment
Worksheets("Hidden Sheet").Cells(8, 6).Value = MayEnvironment
Worksheets("Hidden Sheet").Cells(9, 6).Value = JunEnvironment
Worksheets("Hidden Sheet").Cells(10, 6).Value = JulEnvironment
Worksheets("Hidden Sheet").Cells(11, 6).Value = AugEnvironment
Worksheets("Hidden Sheet").Cells(12, 6).Value = SepEnvironment
Worksheets("Hidden Sheet").Cells(13, 6).Value = OctEnvironment
Worksheets("Hidden Sheet").Cells(14, 6).Value = NovEnvironment
Worksheets("Hidden Sheet").Cells(15, 6).Value = DecEnvironment
Worksheets("Hidden Sheet").Cells(4, 7).Value = JanUnknown
Worksheets("Hidden Sheet").Cells(5, 7).Value = FebUnknown
Worksheets("Hidden Sheet").Cells(6, 7).Value = MarUnknown
Worksheets("Hidden Sheet").Cells(7, 7).Value = AprUnknown
Worksheets("Hidden Sheet").Cells(8, 7).Value = MayUnknown
Worksheets("Hidden Sheet").Cells(9, 7).Value = JunUnknown
Worksheets("Hidden Sheet").Cells(10, 7).Value = JulUnknown
Worksheets("Hidden Sheet").Cells(11, 7).Value = AugUnknown
Worksheets("Hidden Sheet").Cells(12, 7).Value = SepUnknown
Worksheets("Hidden Sheet").Cells(13, 7).Value = OctUnknown
Worksheets("Hidden Sheet").Cells(14, 7).Value = NovUnknown
Worksheets("Hidden Sheet").Cells(15, 7).Value = DecUnknown
Dim n As Long 'num of categories
Dim m As Long 'num of series
n = 12
m = 6
Dim r As Range
Set r = Worksheets("Hidden Sheet").Range("A3")
Set r = r.Resize(n + 1, m + 1)
Dim s As Shape
Set s = Worksheets("Macro Test Sheet").Shapes.AddChart2(-1, xlColumnStacked)
s.Chart.SetSourceData Source:=r
End Sub
本质上，我试图计算每个月发生的每种类型的错误(人为的，材料的，等等)的数量。然后，我尝试将这些计数(比如1月份的人为错误)分配给隐藏表单上的一个单元格。然后我试着画出堆叠图。
下面是对您的代码的重构，它应该可以为您工作。为了清楚起见，我试着注释一下:
Sub SecondaryInterimTracker()
'Declare variables
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsData As Worksheet: Set wsData = wb.Worksheets("Macros Test Sheet")
Dim wsTable As Worksheet: Set wsTable = wb.Worksheets("Hidden Sheet")
Dim rData As Range: Set rData = wsData.Range("C2:H" & wsData.Cells(wsData.Rows.Count, "C").End(xlUp).Row)
Dim rTable As Range: Set rTable = wsTable.Range("A3")
If rData.Row < 2 Then Exit Sub 'No data
'Load the data into an array
Dim aData() As Variant: aData = rData.Value
'Prepare the series headers, and criteria to look for in the data
Dim aSeries(1 To 6) As Variant
aSeries(1) = "Human"
aSeries(2) = "Method/Procedure"
aSeries(3) = "Equipment"
aSeries(4) = "Material"
aSeries(5) = "Environment"
aSeries(6) = "Unknown"
'Prepare results table
Dim aResults() As Variant: ReDim aResults(1 To 13, 1 To UBound(aSeries) + 1)
Dim lResultRow As Long, lResultCol As Long
aResults(1, 1) = "X" 'Top left corner of results table
'Populate top-most row of results table with Series names
lResultCol = 2
Dim vSeries As Variant
For Each vSeries In aSeries
aResults(1, lResultCol) = vSeries
lResultCol = lResultCol + 1
Next vSeries
'Populate left-most column of results table with month names
For lResultRow = 1 To 12
aResults(lResultRow + 1, 1) = Format(DateSerial(Year(Now), lResultRow, 1), "MMMM")
Next lResultRow
'Loop through the data
Dim i As Long, j As Long
For i = 1 To UBound(aData, 1)
If IsDate(aData(i, 1)) Then 'Verify we're looking at a date
lResultRow = Month(aData(i, 1)) + 1 'Row is equal to the month (+1 to get past result table header row)
'Check the Series (Human, Equipment, etc) to get the column
lResultCol = UBound(aResults, 2) 'Assume other/unknown
For j = 1 To UBound(aSeries) - 1 '-1 because we don't need to check for Other/Unknown
If LCase(aData(i, 6)) = LCase(aSeries(j)) Then
lResultCol = j + 1 'If match found, set result col (+1 to get past left-most Months column)
Exit For
End If
Next j
'Add 1 to the appropriate result
aResults(lResultRow, lResultCol) = aResults(lResultRow, lResultCol) + 1
End If
Next i
'Output results
Set rTable = rTable.Resize(UBound(aResults, 1), UBound(aResults, 2))
rTable.Value = aResults
'Create chart
Dim s As Shape
Set s = wsData.Shapes.AddChart2(-1, xlColumnStacked)
s.Chart.SetSourceData Source:=rTable
End Sub
创建层叠列图
Option Explicit
Sub SecondaryInterimTracker()
' Define constants.
' Source
Const sName As String = "Macros Test Sheet"
Const sfRow As Long = 2
Const sdCol As String = "C"
Const scCol As String = "H"
' Destination
Const dName As String = "Hidden Sheet"
Const dFirstCellAddress As String = "A3"
Const drCount As Long = 13 ' headers + 12 months
Const dcCount As Long = 7 ' headers + 5 criteria + 'Unknown'
Const dFirstHeader As String = "X"
Const dLastHeader As String = "Unknown"
' Both
Dim Criteria() As Variant: Criteria = VBA.Array( _
"Human", "Method/Procedure", "Equipment", "Material", "Environment")
Dim Months() As Variant: Months = VBA.Array( _
"January", "February", "March", "April", "May", "June", _
"July", "August", "September", "October", "November", "December")
' Reference the workbook.
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
'Set wb = Workbooks("Query Results.xlsm") ' only if it's not the above
' Reference the source date and criteria ranges ('sdrg', 'scrg')
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, sdCol).End(xlUp).Row
Dim sdrg As Range
Set sdrg = sws.Range(sws.Cells(sfRow, sdCol), sws.Cells(slRow, sdCol))
Dim scrg As Range: Set scrg = sdrg.EntireRow.Columns(scCol)
' Delete ALL chart objects in the source worksheet. Caution, there is no undo!
'Dim cho As ChartObject
'For Each cho In sws.ChartObjects
' cho.Delete
'Next cho
' Write the values from the source range to the destination array ('dData').
' Define the destination array.
Dim dData() As Variant: ReDim dData(1 To drCount, 1 To dcCount)
' Write column headers.
dData(1, 1) = dFirstHeader
Dim dr As Long
Dim dc As Long
For dc = 2 To dcCount - 1
dData(1, dc) = Criteria(dc - 2)
Next dc
dData(1, dcCount) = dLastHeader
' Write row headers.
For dr = 2 To drCount
dData(dr, 1) = Months(dr - 2)
Next dr
' Write data.
Dim sdCell As Range
Dim sdValue As Variant
Dim sdMonth As Long
Dim scIndex As Variant
Dim scString As String
Dim sr As Long
For Each sdCell In sdrg.Cells
sr = sr + 1
sdValue = sdCell.Value
If IsDate(sdValue) Then ' is a date
sdMonth = Month(sdValue) + 1 ' row headers
scString = CStr(scrg.Cells(sr))
scIndex = Application.Match(scString, Criteria, 0)
If IsNumeric(scIndex) Then ' match found
dData(sdMonth, scIndex + 1) = dData(sdMonth, scIndex + 1) + 1
Else ' no match found; write to the last ('Unknown') column.
dData(sdMonth, dcCount) = dData(sdMonth, dcCount) + 1
End If
' Else ' not a date; do nothing
End If
Next sdCell
' Write the values from the destination array to the destination range.
' Reference the destination worksheet ('dws').
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
' Clear previous data.
dws.UsedRange.Clear
' Reference the destination first cell ('dfCell').
Dim dfCell As Range: Set dfCell = dws.Range(dFirstCellAddress)
' Reference the destination range ('drg').
Dim drg As Range: Set drg = dfCell.Resize(drCount, dcCount)
' Write the values from the destination array to the destination range.
drg.Value = dData
' Apply simple formatting.
drg.EntireColumn.AutoFit ' columns
drg.Rows(1).Font.Bold = True ' headers
' Add the chart.
Dim shp As Shape: Set shp = sws.Shapes.AddChart2(-1, xlColumnStacked)
shp.Chart.SetSourceData Source:=drg
' Inform.
MsgBox "Chart created.", vbInformation
End Sub