需要按顺序写几个月

我有一个以月/年为标题的列表（如JAN09，FEB09，AUG10）。 我必须检查这些月份是否按顺序排列。 如果不是，那么alignment它，如果一个特定的月份不可用，然后创build一个列名称标题作为月份名称，然后继续。 我已经写了一个代码，但它的第一年工作（像从09-11年，它将确定所有的09个月，但之后，它不能识别，并创build一个新的月份，即使它是存在的）。

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 

Answer 1

我build议改变你的逻辑和使用词典 。

假设您的数据（列）最初sorting如下： 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）创build包含月份和相应索引的字典。
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 

干杯，
马切伊