我曾经有一个非常简单的矩阵。这个矩阵就像：
year week amount
2002 1 687
until
2013 52 8546
然而，有些星期没有记录。因此，为我编写了以下宏。此宏插入一个新行，在第一列中命名正确的年份，在第二列中命名正确的一周，在第三列中命名为零。
Sub CreateUnrecordedWeeks()
' Defining used objects
Dim FY As Integer, LY As Integer
Dim I As Integer, ii As Integer
Dim ObjDic1 As Object
Set ObjDic1 = CreateObject("Scripting.Dictionary")
Dim ObjDic2 As Object
Set ObjDic2 = CreateObject("Scripting.Dictionary")
Dim WkRg As Range
Dim F As Range
Set WkRg = Cells(1, 1).CurrentRegion
With ObjDic1
For Each F In WkRg.Columns(1).Cells
.Item(F.Value & "/" & F.Offset(0, 1).Value) = F.Offset(0, 2).Value
Next F
' AAA = .keys: BBB = .items
FY = Evaluate("MIN((A:A))")
LY = Evaluate("MAX(A:A)")
For I = FY To LY
For ii = 1 To 52
If (.exists((I & "/" & ii))) Then
ObjDic2.Item(I & "/" & ii) = Array(I, ii, .Item(I & "/" & ii))
Else
ObjDic2.Item(I & "/" & ii) = Array(I, ii, "0")
End If
Next ii
Next I
End With
With ObjDic2
Cells(1, 1).Resize(.Count, 3) = Application.Transpose(Application.Transpose(.items))
End With
End Sub
然而，我的矩阵改为：
Year Week 10230001 10230003 etc etc
2002 1 564 56
until
2013 52 85 5868
所以我的问题是：如何更改宏以使用更大的矩阵（至少174列）
当我使用旧的宏时，我看到宏实际上没有插入一行，而是将下面的单元格向下复制。因此，附加列不会移动，因此将错误的时间变量连接到它。所以我需要向下复制整个矩阵或插入一行。但是如何？
答案 0 :(得分：0)
第1部分很抱歉，答案分为两部分。我无法使用Stack Overflow的新系统发布图像，而我使用的文本表却导致此答案超过30,000个字符限制。我已经报告了这个bug和Stack Overflow的技术人员正在调查。
我没有尝试调试现有代码，因为：
我创建了一些代表你的数据：
| A | B | C | D | E | F | G |
1 |Year |Week |Amounts|--> | | | |
2 | 2002| 2| 11| 21| 31| 41| 51|
3 | 2002| 15| 24| 34| 44| 54| 64|
4 | 2002| 17| | 36| 46| 56| 66|
5 | 2002| 18| 27| 37| 47| 57| |
6 | 2002| 43| 27| 37| 47| 57| 67|
7 | 2002| 44| 28| 38| 48| 58| 68|
8 | 2003| 21| 32| 42| 52| | |
9 | 2003| 23| 34| 44| 54| 64| 74|
10| 2003| 24| 10| 20| 30| 40| 50|
11| 2003| 44| 30| 40| 50| 60| 70|
12| 2003| 45| 31| 41| | | |
13| 2003| 46| 32| 42| 52| 62| 72|
14| 2003| 52| 13| 23| 33| 43| 53|
15| 2003| 53| 14| 24| 34| 44| 54|
16| 2005| 1| 17| 27| 37| 47| |
17| 2005| 29| 20| 30| 40| 50| 60|
18| 2005| 53| 19| 29| 39| 49| 59|
19| 2006| 1| 20| 30| 40| 50| 60|
20| 2006| 2| 11| 21| 31| 41| 51|
21| 2007| 53| 0| 0| 0| 0| 0|
注意事项：
答案 1 :(得分：0)
第2部分
宏运行后开始数据。
| A | B | C | D | E | F | G | H | I |
1 |Year |Week |Amounts|--> | | | | | |
2 | 2002| 1| 0| 0| 0| 0| 0| | |
3 | 2002| 2| 10| 20| 30| 40| | | |
4 | 2002| 3| 11| 21| 31| 41| 51| | |
5 | 2002| 4| 0| 0| 0| 0| 0| | |
6 | 2002| 5| 0| 0| 0| 0| 0| | |
7 | 2002| 6| 0| 0| 0| 0| 0| | |
8 | 2002| 7| 0| 0| 0| 0| 0| | |
9 | 2002| 8| 0| 0| 0| 0| 0| | |
10 | 2002| 9| 0| 0| 0| 0| 0| | |
11 | 2002| 10| 0| 0| 0| 0| 0| | |
12 | 2002| 11| 0| 0| 0| 0| 0| | |
13 | 2002| 12| 0| 0| 0| 0| 0| | |
14 | 2002| 13| 0| 0| 0| 0| 0| | |
15 | 2002| 14| 0| 0| 0| 0| 0| | |
16 | 2002| 15| 24| 34| 44| 54| 64| | |
17 | 2002| 16| 0| 0| 0| 0| 0| | |
18 | 2002| 17| | 36| 46| 56| 66| | |
19 | 2002| 18| 27| 37| 47| 57| | | |
20 | 2002| 19| 0| 0| 0| 0| 0| | |
21 | 2002| 20| 0| 0| 0| 0| 0| | |
22 | 2002| 21| 0| 0| 0| 0| 0| | |
23 | 2002| 22| 0| 0| 0| 0| 0| | |
24 | 2002| 23| 0| 0| 0| 0| 0| | |
25 | 2002| 24| 0| 0| 0| 0| 0| | |
26 | 2002| 25| 0| 0| 0| 0| 0| | |
27 | 2002| 26| 0| 0| 0| 0| 0| | |
28 | 2002| 27| 0| 0| 0| 0| 0| | |
29 | 2002| 28| 0| 0| 0| 0| 0| | |
30 | 2002| 29| 0| 0| 0| 0| 0| | |
尝试使用宏并研究我的代码。我已经解释了宏的每个部分的目标，但我没有解释大多数VBA语句，因为一旦你知道它们存在，通常很容易查找语句。例如，尝试搜索“Excel VBA Option Explicit”。回过头来回答问题，但是你能为自己解决的越多，你的发展就越快。
Option Explicit
' Constants allow you to use names instead of literals that might change over
' time. You only have one header row and perhaps this will not change but
' it is better to avoid making such assumptions. If you ever do add a second
' header row, one change here will fix the macro.
Const RowDataFirst As Long = 2
' Columns can be letters or numbers with "A"=1, "B"=2, "C"=3 and so on
Const ColYear As Long = 1
Const ColWeek As Long = 2
Const ColDataFirst As Long = 3
' Change to your name for the worksheet containing the matrix
Const WshtName As String = "Data"
Sub CreateUnrecordedWeeks()
Dim ColCrnt As Long
Dim ColLast As Long
Dim RowCrnt As Long
Dim RowLast As Long
Dim RowValues() As Variant
Dim WeekCrnt As Long
Dim YearCrnt As Long
' This stops the screen being repainted everytime a row is inserted
Application.ScreenUpdating = False
' "Cells(1, 1).CurrentRegion" requires/assumes that the user has started the
' macro with the correct worksheet active. This may be very likely in this
' case but it is is a bad habit to make this assumption so best not to start.
' Use a With statement to specify the worksheet unless there is an
' operational reason why using the worksheet selected by the user is
' appropriate.
With Worksheets(WshtName)
' Excel VBA often provides several methods of achiving the same objective.
' There are several methods of finding the last row and or column none of
' which gives what the naive programmer might expect in every situation.
' Separate Finds for the last row and last column containing any value is
' the most reliable and I believe appropriate for your situation. In
' particular it allows some existing rows to have missing trailing values
' without this causing problrms for the macro.
RowLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
ColLast = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByColumns, xlPrevious).Column
' "Debug.Print" outputs values to the Immediate Window (at the bottom of the screen).
' I use Debug.Print to check values are as I expect before moving on to the next
' section of the macro.
'Debug.Print "RowLast " & RowLast
'Debug.Print "ColLast " & ColLast
' Validate existing rows have valid years and weeks in ascending order
'=====================================================================
' To add missing rows, the macro requires that, in every case, Row(N+1) is
' for a later year or week than Row(N). Validating that this requirement is
' met before starting the update avoiding creating a half updated matrix.
' For rows RowDataFirst to RowLast:
' 1) column A must hold a value in the range 2000 to 2099
' 2) column B must hold a value in the range 1 to 53
' 3) Cells(Row+1,"A") must be equal to or greater than Cells(Row,"A")
' 4) If Cells(Row+1,"A") equals Cells(Row,"A") then Cells(Row+1,"B")
' must be greater than Cells(Row,"B")
' Check the first data row here. Within loop check the second of each
' pair. This means each row is only checked once
If Not HasRowValidYearWeek(RowDataFirst) Then
' User has already been told of problem
' "Debug.Assert False" stops execution. I place it at the top of every path
' through my code. Once it has been reached, I comment it out. Any that remain
' when I have finished testing imply my testing has been inadequate.
'Debug.Assert False
Exit Sub
End If
' Check each data row (except the first) against the previous row
For RowCrnt = RowDataFirst + 1 To RowLast
If Not HasRowValidYearWeek(RowCrnt) Then
' User has already been told of problem
'Debug.Assert False
Exit Sub
End If
If .Cells(RowCrnt, ColYear) = .Cells(RowCrnt - 1, ColYear) Then
If .Cells(RowCrnt, ColWeek) > .Cells(RowCrnt - 1, ColWeek) Then
' Same year, increased week so current row belongs after previous row
'Debug.Assert False
ElseIf .Cells(RowCrnt, ColWeek) = .Cells(RowCrnt - 1, ColWeek) Then
'Debug.Assert False
Call MsgBox("Row " & RowCrnt & " has the same year" & _
" and week as the previous row.", vbOKOnly)
Exit Sub
Else
'Debug.Assert False
Call MsgBox("Row " & RowCrnt & _
" belongs before the previous row.", vbOKOnly)
Exit Sub
End If
ElseIf .Cells(RowCrnt, ColYear) > .Cells(RowCrnt - 1, ColYear) Then
' Increased year so current row belongs after previous row
'Debug.Assert False
Else
'Debug.Assert False
Call MsgBox("Row " & RowCrnt & _
" belongs before the previous row.", vbOKOnly)
End If
Next
'Debug.Print "Data OK"
' Generate a row of zeros for any row to be inserted. This row is the length
' of the longest existing row.
ReDim RowValues(1 To 1, 1 To ColLast)
' VBA allows a range to loaded to an array or an array to be loaded to a
' range with:
' 1) VariantArray = Range.Value
' 2) Range.Value = VariantArray
' With format 1, the interpreted ReDims VariantArray to match the range
' size. With format 2, The range and array sizes should match. I leave you
' to experiment to discover what happens if the the sizes do not match.
' VariantArray is a two dimensional array. The first dimension is for rows
' and the second for columns. The is the opposite of the normal convention
' but means the access matches Cells(Row, Column)
' RowValues(1, ColYear) and RowValues(1, ColWeek) will be overwritten when
' a row is inserted.
For ColCrnt = 1 To ColLast
RowValues(1, ColCrnt) = 0
Next
RowCrnt = 2
' The first row must be for week 1 of a year
YearCrnt = .Cells(RowCrnt, ColYear).Value
WeekCrnt = 0
' This is the main loop. It cannot be a For-Loop because rows will be
' inserted and the end value for a For-Loop can be changed within the loop.
' Each repeat of this loop does one of the following:
' 1) Determines that the next required row is already present and
' advances to the next row
' 2) Determines a mid-year is missing and inserts it. The previous
' current row remains the current row
' 3) Determines the current year is complete and prepares for the next
' 4) Determines a trailing week for a year is missing and adds it. The
' year previous current row remains the current row
Do While RowCrnt <= RowLast
If YearCrnt = .Cells(RowCrnt, ColYear).Value Then
' Have another row for the same year
'Debug.Assert False
WeekCrnt = WeekCrnt + 1
If WeekCrnt = .Cells(RowCrnt, ColWeek).Value Then
' The next row is already present
'Debug.Assert False
RowCrnt = RowCrnt + 1 ' Advance to next row
' No more processing for this loop
Else
' The next row is not present
'Debug.Assert False
.Rows(RowCrnt).Insert ' Insert row above RowCrnt
RowLast = RowLast + 1
RowValues(1, ColYear) = YearCrnt
RowValues(1, ColWeek) = WeekCrnt
.Range(.Cells(RowCrnt, 1), .Cells(RowCrnt, ColLast)).Value = RowValues
RowCrnt = RowCrnt + 1 ' Advance to previous current row
' No more processing for this loop
End If
Else
' Next row is for a different year
'Debug.Assert False
If WeekCrnt = 52 Or WeekCrnt = 53 Then
' YearCrnt is finished
'Debug.Assert False
YearCrnt = YearCrnt + 1
WeekCrnt = 0
' No more processing for this loop
Else
' A trailing week is missing. Add it.
'Debug.Assert False
WeekCrnt = WeekCrnt + 1
.Rows(RowCrnt).Insert ' Insert row above RowCrnt
RowLast = RowLast + 1
RowValues(1, ColYear) = YearCrnt
RowValues(1, ColWeek) = WeekCrnt
.Range(.Cells(RowCrnt, 1), .Cells(RowCrnt, ColLast)).Value = RowValues
RowCrnt = RowCrnt + 1 ' Advance to previous current row
' No more processing for this loop
End If
End If
Loop
End With
Application.ScreenUpdating = True
End Sub
Function ColNumToCode(ByVal ColNum As Long) As String
Dim ColCode As String
Dim PartNum As Long
' Last updated 3 Feb 12. Adapted to handle three character codes.
If ColNum = 0 Then
ColNumToCode = "0"
Else
ColCode = ""
Do While ColNum > 0
PartNum = (ColNum - 1) Mod 26
ColCode = Chr(65 + PartNum) & ColCode
ColNum = (ColNum - PartNum - 1) \ 26
Loop
End If
ColNumToCode = ColCode
End Function
Function HasRowValidYearWeek(ByVal RowCrnt As Long) As Boolean
' Return True if column ColYear of RowCrnt is in the range 2000-2099 and
' column ColWeek of RowCrnt is in the range 1-53
HasRowValidYearWeek = True
With Worksheets(WshtName)
If IsNumeric(.Cells(RowCrnt, ColYear).Value) Then
If .Cells(RowCrnt, ColYear).Value >= 2000 And _
.Cells(RowCrnt, ColYear).Value <= 2099 Then
'Debug.Assert False
' Column A of first data row has good value
Else
'Debug.Assert False
Call MsgBox("Cell " & ColNumToCode(ColYear) & RowCrnt & _
" is not in the range 2000-2099.", vbOKOnly)
HasRowValidYearWeek = False
End If
Else
'Debug.Assert False
Call MsgBox("Cell " & ColNumToCode(ColYear) & RowCrnt & _
" is not numeric.", vbOKOnly)
HasRowValidYearWeek = False
End If
If IsNumeric(.Cells(RowCrnt, ColWeek).Value) Then
If .Cells(RowCrnt, ColWeek).Value >= 1 And _
.Cells(RowCrnt, ColWeek).Value <= 53 Then
'Debug.Assert False
' Column A of first data row has good value
Else
'Debug.Assert False
Call MsgBox("Cell " & ColNumToCode(ColWeek) & RowCrnt & _
" is not in the range 1-53.", vbOKOnly)
HasRowValidYearWeek = False
End If
Else
'Debug.Assert False
Call MsgBox("Cell " & ColNumToCode(ColWeek) & RowCrnt & _
" is not numeric.", vbOKOnly)
HasRowValidYearWeek = False
End If
End With
End Function