我有一个以月/年为标题的列的列表（如JAN09，FEB09，AUG10）。我必须检查月份是否按顺序排列。如果没有，则将其对齐，如果没有特定的月份，则创建一个列名称标题作为月份名称，然后继续。我已经编写了一个代码，但是它适用于第一年（例如从09-11年开始，它将标识09的所有月份，但是此后，即使存在，它也无法标识并创建一个新的月份）。
Sub MonthFinder()
Dim montharray As Variant
montharray = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
lastrow = ActiveSheet.UsedRange.Rows.Count + 5
lastcol = ActiveSheet.UsedRange.Columns.Count
minmonth = Right(Cells(5, 2), 2)
range0 = 2
maxmonth = Right(Cells(5, 2), 2)
Do Until range0 > lastcol
If Right(Cells(5, range0), 2) < minmonth Then
minmonth = Right(Cells(5, range0), 2)
End If
If Right(Cells(5, range0), 2) > maxmonth Then
maxmonth = Right(Cells(5, range0), 2)
End If
range0 = range0 + 1
Loop
minsortmonth = minmonth
maxsortmonth = maxmonth
place = 2
Do Until minsortmonth = maxsortmonth + 1
arraycount = 0
Do Until arraycount = 12
range1 = 2
lastcol = ActiveSheet.UsedRange.Columns.Count
Do Until Left(Cells(5, range1), 3) = montharray(arraycount) And Right(Cells(5, range1), 2) = minsortmonth Or range1 > lastcol
range1 = range1 + 1
Loop
If range1 > lastcol Then
Range(Cells(5, place), Cells(lastrow, place)).Select
Selection.Insert Shift:=xlToRight
Cells(5, place).Value = montharray(arraycount) & minsortmonth
Else
If range1 <> place Then
Range(Cells(5, range1), Cells(lastrow, range1)).Cut
Cells(5, place).Select
Selection.Insert Shift:=xlToRight
End If
End If
arraycount = arraycount + 1
place = place + 1
Loop
minsortmonth = minsortmonth + 1
Loop
End Sub
最佳答案
我建议更改您的逻辑并使用Dictionary。
假设您的数据（列）的初始排序如下：JAN09，FEB09，APR09 ... MAR00，MAY00，JUL00等。。。月份收集中有一些空白，您想填写缺少的月份。这是一个主意：
'Note: columns are initially sorted!
Sub CheckMonthSequence()
Dim dic As Dictionary
Dim element As Variant
Dim col As Integer, pos As Integer, rng As Range
Dim initialDate As Date, endDate As Date, sTmp As String
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("B5")
'define initial date as January of ...
sTmp = rng
sTmp = "01/01/" & "20" & Right(sTmp, 2)
initialDate = CDate(sTmp)
'define end date
sTmp = rng.End(xlToRight)
sTmp = Left(sTmp, 3) & "/01/" & "20" & Right(sTmp, 2)
endDate = CDate(sTmp)
'create new dictionary with collection of months
Set dic = GetMonthsAsDictionary(initialDate, endDate)
'define a range of columns to sort and update
col = 0
Do While rng.Offset(, col) <> ""
element = rng.Offset(, col)
If dic.Exists(element) Then
pos = dic.Item(element)
If pos > col Then
Do While col < pos
rng.Offset(, col).EntireColumn.Insert xlShiftToRight
'sometimes it loses the reference, so...
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("B5")
rng.Offset(, col) = GetKeyByIndex(dic, col)
col = col + 1
Loop
col = pos
End If
End If
col = col + 1
Loop
End Sub
'needs reference to MS Scripting Runtime
Function GetMonthsAsDictionary(ByVal StartingMonth As Date, EndMonth As Date) As Dictionary
Dim dic As Dictionary
Dim i As Integer, j As Integer
'create new dictionary
Set dic = New Dictionary
i = 0
j = DateDiff("M", StartingMonth, EndMonth)
For i = 0 To j
dic.Add UCase(Format(DateAdd("M", i, StartingMonth), "MMMyy")), i
Debug.Print UCase(Format(DateAdd("M", i, StartingMonth), "MMMyy")), i
Next
Set GetMonthsAsDictionary = dic
End Function
Function GetKeyByIndex(ByVal dic As Dictionary, ByVal ind As Integer) As String
Dim dic_Keys As Variant, element As Variant
dic_Keys = dic.keys
For Each element In dic_Keys
If dic.Item(element) = ind Then
Exit For
End If
Next
GetKeyByIndex = element
End Function
如您所见，上面的代码：
1）创建包含月份和相应索引的字典。
2）遍历列的集合
3）检查值是否对应于字典中的索引
4）必要时填写标题。
我知道，这并不完美，但是很好的起点。
干杯
[编辑]
使用您的逻辑，代码可能类似于：
Option Explicit 'do not apply initialize variable without its declaration
Sub MonthFinder()
Dim montharray As Variant, rng As Range
Dim firstyear As Integer, lastyear As Integer, curryear As Integer
Dim curroffset As Integer, lastcol As Integer, currmonth As Integer
curroffset = 0
montharray = Array("JAN", "FEB", "MAR", "APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT", "NOV", "DEC")
'start here:
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("B5")
'first year
firstyear = CInt(Right(rng, 2))
'fid last col
lastcol = rng.End(xlToRight).Column - rng.Column
'find last year
lastyear = CInt(Right(rng.Offset(ColumnOffset:=lastcol), 2))
For curryear = firstyear To lastyear
For currmonth = LBound(montharray) To UBound(montharray)
'if current month is equal to last month - exit for
If CStr(montharray(currmonth) & curryear) = CStr(rng.End(xlToRight)) Then Exit For
'month is proper - do nothing
If rng.Offset(ColumnOffset:=curroffset) = CStr(montharray(currmonth) & curryear) Then GoTo SkipMonth
'other cases
rng.Offset(ColumnOffset:=curroffset).EntireColumn.Insert xlShiftToRight
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("B5")
rng.Offset(ColumnOffset:=curroffset) = CStr(montharray(currmonth) & curryear)
SkipMonth:
curroffset = curroffset + 1
Next
Next
Set rng = Nothing
End Sub
干杯，
Maciej
关于excel - 需要按顺序写几个月，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/27705859/