这是我第一次发帖,如果我没有遵守本论坛通常的格式规则,我深表歉意。
所以,我使用这个 VBA 表已经有一段时间了,但由于 Windows 10 迁移,我无法运行宏。我一直在尝试解决这个问题,但我缺乏技能阻碍了我。该宏只是根据日期对甘特图进行排序。
这是我得到的错误。 Run Time Error - 1004
这是代码错误的图像。 Debugging Error
&这里是完整的代码供您参考。
Option Explicit
Sub SortMe()
'
Range("I4").Select
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Add _
Key:=Range("Table1[[#All],[Start Date]]"), SortOn:=xlSortOnValues, Order _
:=xlDescending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort.SortFields.Add _
Key:=Range("Table1[[#All],[Start Date]]"), SortOn:=xlSortOnValues, Order _
:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("Sheet1").ListObjects("Table1").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("L:CQ").Select
Selection.Delete Shift:=xlToLeft
Range("L3").Select
ActiveCell.FormulaR1C1 = Date
Dim i As Integer
For i = 1 To 83
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = Date + i
Next i
Columns("L:CQ").Select
Selection.ColumnWidth = 1.43
Dim RowCount As Integer
RowCount = Range("C4").End(xlDown).Row - 3
Dim FirstCol, LastCol As String
FirstCol = Format(Date, "m/d/yyyy")
LastCol = Format(Date + 83, "m/d/yyyy")
'Add the formulas for Gantt
Range("L4").Select
ActiveCell.FormulaR1C1 = _
"=IF(AND(DATEVALUE(R3C)>=RC9,DATEVALUE(R3C)<=RC9+RC11),IF(LEN(RC4)<3,2,1),"""")"
Range("Table1[" & FirstCol & "]").Select
Selection.AutoFill Destination:=Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]"), _
Type:=xlFillDefault
Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]").Select
'Formatting Gantt Chart
Range("L4").Select
Cells.FormatConditions.Delete
Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=1"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -4165632
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 12611584
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("Table1[[" & FirstCol & "]:[" & LastCol & "]]").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=2"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16777024
.TintAndShade = 0
End With
With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 192
.TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
'Add Months
Rows("2:2").Select
Rows("2:2").EntireRow.Delete
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("L2").Select
ActiveCell.FormulaR1C1 = Date
For i = 1 To 83
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = Date + i
ActiveCell.NumberFormat = "mmm"
Next i
Dim Bcell As Range
Dim MergeRange As String
Dim CurMonth As Integer
CurMonth = Month(Range("L2"))
MergeRange = "$L$2:"
Application.DisplayAlerts = False
For Each Bcell In Range("L2").Resize(1, 84)
If CurMonth <> Month(Bcell) Then
'MsgBox "New month at " & Bcell.Address
MergeRange = MergeRange & Bcell.Offset(0, -1).Address
Range(MergeRange).Select
Selection.Merge
Selection.NumberFormat = "mmmm"
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Size = 16
MergeRange = Bcell.Address & ":"
End If
CurMonth = Month(Bcell)
Next Bcell
'Merge last month
MergeRange = MergeRange & "$CQ$2"
Range(MergeRange).Select
Selection.Merge
'format last month
Selection.NumberFormat = "mmmm"
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = True
End With
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.Font.Size = 16
End Sub