英文:
How can I fix the issues caused by using column.insert to add a column in my VBA macro?
问题
请帮助我理解如何更新这个VBA以更改输出文件，以包括一个额外的列并更新现有列标题以反映以下内容; “Add Delay Code”和“Remove Delay Code”? 我相信通过更新列G中的现有“Delay Code”字段为“Add Delay Code”并将列H、I和J向右移动，以便列H可以成为新的“Remove Delay Code”列，我可以实现这个需求。但是，我是一个完全不懂VBA的初学者，不知道从哪里开始。
Sub Macro2()
'
' Macro2 Macro
'
Dim startcell As String
Dim Lastrow As String
Dim Lastrow2 As String
Dim rowCount As Integer
Dim ws As String
Dim Nws As String
Dim Nwo As String
Dim Firstcell As Integer
Dim Lastcell As String
Dim Firstrow As Integer
Dim WO1 As String
Dim WO2 As String
Dim WOlastROW As String
Dim StartTime As Date, EndTime As Date
Dim TimeTaken As Double
'
'StartTime = Time
Application.EnableEvents = False
Application.ScreenUpdating = False
GetUserName = Application.UserName
Sheets("OUTLOOK DATA").Visible = True
Sheets("OUTLOOK DATA").Select
Range("A1").Select
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Lastcell = "V" & (Lastrow)
Selection.AutoFilter
ActiveSheet.Range("$A$1:" & (Lastcell)).AutoFilter Field:=1, Criteria1:= _
"=*Crew*", Operator:=xlAnd
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Range("A1").Select
Selection.AutoFilter
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:M").Select
Selection.Delete Shift:=xlToLeft
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("A:D").EntireColumn.AutoFit
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlFixedWidth, _
OtherChar:="-", FieldInfo:=Array(Array(0, 1), Array(9, 1)), _
TrailingMinusNumbers:=True
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E" & (Lastrow)), , xlYes).Name = _
"Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium2"
Columns("A:D").EntireColumn.AutoFit
Sheets.Add After:=ActiveSheet
Sheets("OUTLOOK DATA").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ws = ActiveSheet.Name
rowCount = 1
startcell = ("A1")
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range(startcell, ("A" + (Lastrow))).Select
ActiveSheet.Range("$A$1:A" & (Lastrow)).RemoveDuplicates Columns:=1, Header:=xlNo
ws = ActiveSheet.Name
rowCount = 1
startcell = ("A1")
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range(startcell, ("A" + (Lastrow))).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range(startcell, ("A" + (Lastrow))), , xlNo).Name = _
"Table2"
Range("Table2[[#All],[Column1]]").Select
ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight1"
ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort.SortFields.Add _
Key:=Range("Table2[[#All],[Column1]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B2").Select
ActiveCell.FormulaR1C1 = "=MATCH([@Column1],'OUTLOOK DATA'!C[-1],0)"
rowCount = 1
startcell = ("A2")
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
For Each i In Range(startcell, ("A" + (Lastrow)))
rowCount = rowCount + 1
Nwo = Cells((rowCount), 1).Value
Firstrow = Cells((rowCount), 2).Value
Secondrow = (Firstrow) + 1
Sheets("OUTLOOK DATA").Select
WO1 = Range("A" & (Firstrow))
WO2 = Range("A" & (Secondrow))
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
(Nwo)
Range("A" & (Firstrow)).Select
WOlastROW = Selection.End(xlDown).Row
If (WO1) = (WO2) Then
Range("C" & (WOlastROW)).Select
Selection.Copy
Range("C" & (Firstrow)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
ActiveSheet.ShowAllData
Sheets("Sheet1").Select
Next i
Sheets("OUTLOOK DATA").Select
Application.CutCopyMode = False
ActiveSheet.Range("Table1[#All]").RemoveDuplicates Columns:=1, Header:= _
xlYes
ActiveWorkbook.Worksheets("OUTLOOK DATA").ListObjects("Table1").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("OUTLOOK DATA").ListObjects("Table1").Sort. _
SortFields.Add2 Key:=Range("Table1[[#All],[Subject]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
<details>
<summary>英文:</summary>
Can anyone help me understand how I can update this VBA to change the output file to include an additional column and update an existing column header to reflect the following; "Add Delay Code" and "Remove Delay Code"? I believe I can achieve the need by updating the existing "Delay Code" field in Column G to "Add Delay Code" and shift the Columns H, I and J to the right so that Column H can become the new "Remove Delay Code" column. However, I'm a complete VBA n00b and I don't know where to start.
Sub Macro2()
'
' Macro2 Macro
'
Dim startcell As String
Dim Lastrow As String
Dim Lastrow2 As String
Dim rowCount As Integer
Dim ws As String
Dim Nws As String
Dim Nwo As String
Dim Firstcell As Integer
Dim Lastcell As String
Dim Firstrow As Integer
Dim WO1 As String
Dim WO2 As String
Dim WOlastROW As String
Dim StartTime As Date, EndTime As Date
Dim TimeTaken As Double
'
'StartTime = Time
Application.EnableEvents = False
Application.ScreenUpdating = False
GetUserName = Application.UserName
Sheets("OUTLOOK DATA").Visible = True
Sheets("OUTLOOK DATA").Select
Range("A1").Select
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Lastcell = "V" & (Lastrow)
Selection.AutoFilter
ActiveSheet.Range("$A$1:" & (Lastcell)).AutoFilter Field:=1, Criteria1:= _
"=*Crew*", Operator:=xlAnd
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
Range("A1").Select
Selection.AutoFilter
Columns("C:C").Select
Selection.Delete Shift:=xlToLeft
Columns("D:M").Select
Selection.Delete Shift:=xlToLeft
Columns("E:K").Select
Selection.Delete Shift:=xlToLeft
Columns("A:D").EntireColumn.AutoFit
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("F1"), DataType:=xlFixedWidth, _
OtherChar:="-", FieldInfo:=Array(Array(0, 1), Array(9, 1)), _
TrailingMinusNumbers:=True
Columns("G:G").Select
Selection.Delete Shift:=xlToLeft
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Copy
Columns("A:A").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("F:F").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1:E1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E" & (Lastrow)), , xlYes).Name = _
"Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium2"
Columns("A:D").EntireColumn.AutoFit
Sheets.Add After:=ActiveSheet
Sheets("OUTLOOK DATA").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ws = ActiveSheet.Name
rowCount = 1
startcell = ("A1")
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range(startcell, ("A" + (Lastrow))).Select
ActiveSheet.Range("$A$1:A" & (Lastrow)).RemoveDuplicates Columns:=1, Header:=xlNo
ws = ActiveSheet.Name
rowCount = 1
startcell = ("A1")
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
Range(startcell, ("A" + (Lastrow))).Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range(startcell, ("A" + (Lastrow))), , xlNo).Name = _
"Table2"
Range("Table2[[#All],[Column1]]").Select
ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight1"
ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort.SortFields.Clear
ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort.SortFields.Add _
Key:=Range("Table2[[#All],[Column1]]"), SortOn:=xlSortOnValues, Order:= _
xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("B2").Select
ActiveCell.FormulaR1C1 = "=MATCH([@Column1],'OUTLOOK DATA'!C[-1],0)"
rowCount = 1
startcell = ("A2")
Lastrow = Range("A" & Rows.Count).End(xlUp).Row
For Each i In Range(startcell, ("A" + (Lastrow)))
rowCount = rowCount + 1
Nwo = Cells((rowCount), 1).Value
Firstrow = Cells((rowCount), 2).Value
Secondrow = (Firstrow) + 1
Sheets("OUTLOOK DATA").Select
WO1 = Range("A" & (Firstrow))
WO2 = Range("A" & (Secondrow))
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
(Nwo)
Range("A" & (Firstrow)).Select
WOlastROW = Selection.End(xlDown).Row
If (WO1) = (WO2) Then
Range("C" & (WOlastROW)).Select
Selection.Copy
Range("C" & (Firstrow)).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
ActiveSheet.ShowAllData
Sheets("Sheet1").Select
Next i
Sheets("OUTLOOK DATA").Select
Application.CutCopyMode = False
ActiveSheet.Range("Table1[#All]").RemoveDuplicates Columns:=1, Header:= _
xlYes
ActiveWorkbook.Worksheets("OUTLOOK DATA").ListObjects("Table1").Sort. _
SortFields.Clear
ActiveWorkbook.Worksheets("OUTLOOK DATA").ListObjects("Table1").Sort. _
SortFields.Add2 Key:=Range("Table1[[#All],[Subject]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("OUTLOOK DATA").ListObjects("Table1"). _
Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("B:C").Select
Selection.NumberFormat = "m/d/yy;@"
Range("Table1[[#Headers],[Subject]]").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Order"
Range("Table1[[#Headers],[Start Date]]").Select
ActiveCell.FormulaR1C1 = "Start"
Range("Table1[[#Headers],[End Date]]").Select
ActiveCell.FormulaR1C1 = "Finish"
Range("Table1[[#Headers],[column1]]").Select
ActiveCell.FormulaR1C1 = "SCH Grade"
Range("E2").Select
ActiveCell.Formula2R1C1 = "=IFS(ISNUMBER(SEARCH(""Hard Date"",[@Categories],1)),""B"",ISNUMBER(SEARCH(""Firm Date"",[@Categories],1)),""C"",ISNUMBER(SEARCH(""Flex Date"",[@Categories],1)),""D"")"
Range("Table1[SCH Grade]").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells.Replace What:="#N/A", Replacement:="D", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Sheets("SAP DATA").Select
Range("Activity[[#Headers],[Suboperation]]") = "Start"
Range("Activity[[#Headers],[MaintenancePlan]]") = "Finish"
Range("Activity[[#Headers],[SystemCondition]]") = "Update User Status"
Range("Activity[[#Headers],[Description]]") = "SCH Grade Update"
Range("Activity[[#Headers],[Op.short text]]") = "Delay Code"
Range("Activity[[#Headers],[Op.System Cond.]]") = "Scheduler"
Range("C2:G3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Columns("E:G").NumberFormat = "General"
Columns("C:D").NumberFormat = "m/d/yy;@"
'Range("C2").Select
Range("C2").FormulaR1C1 = "=VLOOKUP([@Order],Table1,2,FALSE)"
'Columns("C:C").Select
'Range("D2").Select
Range("D2").FormulaR1C1 = "=VLOOKUP([@Order],Table1,3,FALSE)"
'Range("E2").Select
Range("E2").FormulaR1C1 = "=IF(LEFT([@[User status]],3)=""RSC"",""Yes"",""No"")"
'Range("F2").Select
Range("F2").FormulaR1C1 = "=VLOOKUP([@Order],Table1,4,FALSE)"
Range("Activity[[#Headers],[Order]:[Scheduler]]").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("I:K").Select
Selection.ClearContents
Selection.NumberFormat = "General"
Range("Activity[[#Headers],[Column1]]").Select
ActiveCell.FormulaR1C1 = "Delete"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=IF([@Start]=[@[Earl.start date]],""YES"","""")"
Range("Activity[[#Headers],[Column2]]").Select
ActiveCell.FormulaR1C1 = "Check"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF([@Finish]=[@EarliestEndDate],""YES"","""")"
Range("Activity[[#Headers],[Column3]]").Select
ActiveCell.FormulaR1C1 = "Goodbye"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=COUNTIFS([@[Update User Status]],""No"",[@Delete],""YES"",[@Check],""YES"")"
Sheets("Sheet1").Select
Range("AA1").Select
ActiveCell.FormulaR1C1 = "=COUNTIF(Activity[Goodbye],1)"
Sheets("SAP DATA").Select
If Sheets("Sheet1").Range("AA1") > 0 Then
ActiveWorkbook.Worksheets("SAP DATA").ListObjects("Activity").Sort.SortFields. _
Clear
ActiveWorkbook.Worksheets("SAP DATA").ListObjects("Activity").Sort.SortFields. _
Add2 Key:=Range("Activity[[#All],[Goodbye]]"), SortOn:=xlSortOnValues, _
Order:=xlDescending, DataOption:=xlSortTextAsNumbers
With ActiveWorkbook.Worksheets("SAP DATA").ListObjects("Activity").Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveSheet.ListObjects("Activity").Range.AutoFilter Field:=11, Criteria1:= _
"1"
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
ActiveSheet.ShowAllData
End If
Range("A2").Select
Columns("I:I").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("Activity[Scheduler]") = GetUserName
Columns("A:H").EntireColumn.AutoFit
Range("J2").Select
ActiveCell.FormulaR1C1 = _
"S:\LDC-LI\Central Scheduling Folder\Outlook Exports\Bot Intake Form"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Copy data to file destination below"
Range("J1:J2").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("J1").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent4
.TintAndShade = 0.399975585192419
.PatternTintAndShade = 0
End With
Range("J1:J2").Select
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
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Columns("J:J").Select
Selection.ColumnWidth = 75
Range("Activity[[#Headers],[Order]]").Select
Range("Activity[[#Headers],[Order]]").Select
Sheets("Macro Controls").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet1").Select
ActiveWindow.SelectedSheets.Delete
Sheets("OUTLOOK DATA").Select
ActiveWindow.SelectedSheets.Delete
Application.EnableEvents = True
Application.ScreenUpdating = True
'EndTime = Time
SAVE
'TimeTaken = (EndTime - StartTime) * 24 * 60 * 60
'MsgBox TimeTaken
End Sub
Private Sub SAVE()
'
' Creating a new book in which to place schedules
' Thanks Shawn for your Googling expertise 12-12-17
' Tuesday is officially "BREAKTHROUGH DAY"
USID = Environ("UserName")
ActiveWorkbook.SaveAs Filename:="C:\Users\" & (USID) & "\Desktop\" & "BOT DATA DROP" & ".xlsx", FileFormat _
:=xlOpenXMLWorkbook, Password:="", WriteResPassword:="", ReadOnlyRecommended:= _
False, CreateBackup:=False
End Sub
Sub GetWorkorderNumbers()
Dim Lastrow As String
Dim NewLastrow As String
'
Sheets("Outlook Data").Select
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("AA1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"&", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers _
:=True
Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("AB:AC").Select
Selection.Copy
Range("A1:B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B1").Select
ActiveCell.FormulaR1C1 = "2nd WO"
Columns("AB:AB").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Lastrow = Range("A" & Rows.Count).End(xlUp).Row + 1
Range("B2:W" & Lastrow).Select
Selection.Copy
Range("B" & Lastrow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
NewLastrow = Range("C" & Rows.Count).End(xlUp).Row
Range("B" & Lastrow & ":B" & NewLastrow).Select
Selection.Copy
Range("A" & Lastrow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Sheets("Macro Controls").Select
Range("A:A").EntireColumn.Hidden = False
ActiveSheet.ListObjects("WOnumbers").Range.AutoFilter Field:=1, Criteria1:= _
"<>1*", Operator:=xlOr, Criteria2:="="
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.EntireRow.Delete
ActiveSheet.ListObjects("WOnumbers").Range.AutoFilter Field:=1
Range("A2").Select
ActiveSheet.Range("WOnumbers[#All]").RemoveDuplicates Columns:=1, Header:= _
xlYes
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("WOnumbers[[#Headers],[Order Numbers]]").Select
Sheets("OUTLOOK DATA").Visible = False
Sheets("SAP DATA").Visible = True
End Sub
I've tried to add the column with column.insert code, and it caused everything to go haywire. I am feeling like this code is too complex for a simple fix. This is also a 'part 2' macros I have to another 'part 1' macros that formats data from Microsoft Outlook to align with data that comes from SAP in 'part 2'.
</details>
# 答案1
**得分**: 1
我不知道这是否是你所面对的问题（因为坦白说，我不打算尝试理解你的代码 - 这么长的代码块实在太多了 - 这样长的过程实际上不应该存在，通常你会尝试将不同的功能拆分成子程序和函数）。
但现在我认为可能存在的问题是，当插入时，你正在改变列的位置。如果你在A列之后插入1列，那么列B现在将成为列C，依此类推。这将破坏对列B或C（或任何大于A的其他列）的可能引用 - 这就是为什么在插入行和列时，通常从最大的开始，然后从那里往回工作的原因。例如，假设你想在A、D和F之后插入一列。那么你应该首先在F之后插入列，然后是D，最后是A。这样，后续的插入操作将不会受到其他插入操作引起的列的移动的影响。
<details>
<summary>英文:</summary>
I don't know if this is the problem you face (because frankly I am not gonna try understanding your code - this wall of code is just too much - a procedure this long shoudn't really exist, you'd usually try and split different functionalities into subs and functions.)
But now to what I think could be the issue you are facing. When inserting you are changing what Columns are where. If you insert 1 Column after Column A; Column B will now be Column C and so on. This will then screw up possible references to Column B or C (or any other Column greater than A) - This is why, when inserting Rows and Columns you usually start with the biggest and work back from there. For example say you want to insert a column after A, D and F. Then you'd start by inserting the Column after F, then D and at last A. This way subsequent insert operations will not be affected by the shifting of columns caused by other insert operations.
</details>
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论