如何修复使用column.insert在我的VBA宏中添加列引起的问题？

huangapple
go评论98阅读模式
英文:

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的初学者，不知道从哪里开始。

  1. Sub Macro2()
  2. '
  3. ' Macro2 Macro
  4. '
  5. Dim startcell As String
  6. Dim Lastrow As String
  7. Dim Lastrow2 As String
  8. Dim rowCount As Integer
  9. Dim ws As String
  10. Dim Nws As String
  11. Dim Nwo As String
  12. Dim Firstcell As Integer
  13. Dim Lastcell As String
  14. Dim Firstrow As Integer
  15. Dim WO1 As String
  16. Dim WO2 As String
  17. Dim WOlastROW As String
  18. Dim StartTime As Date, EndTime As Date
  19. Dim TimeTaken As Double
  20. '
  21. 'StartTime = Time
  22. Application.EnableEvents = False
  23. Application.ScreenUpdating = False
  24. GetUserName = Application.UserName
  25. Sheets("OUTLOOK DATA").Visible = True
  26. Sheets("OUTLOOK DATA").Select
  27. Range("A1").Select
  28. Lastrow = Range("A" & Rows.Count).End(xlUp).Row
  29. Lastcell = "V" & (Lastrow)
  30. Selection.AutoFilter
  31. ActiveSheet.Range("$A$1:" & (Lastcell)).AutoFilter Field:=1, Criteria1:= _
  32. "=*Crew*", Operator:=xlAnd
  33. Rows("2:2").Select
  34. Range(Selection, Selection.End(xlDown)).Select
  35. Selection.Delete Shift:=xlUp
  36. ActiveSheet.ShowAllData
  37. Range("A1").Select
  38. Selection.AutoFilter
  39. Columns("C:C").Select
  40. Selection.Delete Shift:=xlToLeft
  41. Columns("D:M").Select
  42. Selection.Delete Shift:=xlToLeft
  43. Columns("E:K").Select
  44. Selection.Delete Shift:=xlToLeft
  45. Columns("A:D").EntireColumn.AutoFit
  46. Columns("A:A").Select
  47. Selection.TextToColumns Destination:=Range("F1"), DataType:=xlFixedWidth, _
  48. OtherChar:="-", FieldInfo:=Array(Array(0, 1), Array(9, 1)), _
  49. TrailingMinusNumbers:=True
  50. Columns("G:G").Select
  51. Selection.Delete Shift:=xlToLeft
  52. Columns("F:F").Select
  53. Application.CutCopyMode = False
  54. Selection.Copy
  55. Columns("A:A").Select
  56. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  57. :=False, Transpose:=False
  58. Columns("F:F").Select
  59. Application.CutCopyMode = False
  60. Selection.Delete Shift:=xlToLeft
  61. Range("A1:E1").Select
  62. Range(Selection, Selection.End(xlDown)).Select
  63. Application.CutCopyMode = False
  64. Lastrow = Range("A" & Rows.Count).End(xlUp).Row
  65. ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E" & (Lastrow)), , xlYes).Name = _
  66. "Table1"
  67. Range("Table1[#All]").Select
  68. ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleMedium2"
  69. Columns("A:D").EntireColumn.AutoFit
  70. Sheets.Add After:=ActiveSheet
  71. Sheets("OUTLOOK DATA").Select
  72. Range("A2").Select
  73. Range(Selection, Selection.End(xlDown)).Select
  74. Application.CutCopyMode = False
  75. Selection.Copy
  76. Sheets("Sheet1").Select
  77. Range("A1").Select
  78. ActiveSheet.Paste
  79. Application.CutCopyMode = False
  80. ws = ActiveSheet.Name
  81. rowCount = 1
  82. startcell = ("A1")
  83. Lastrow = Range("A" & Rows.Count).End(xlUp).Row
  84. Range(startcell, ("A" + (Lastrow))).Select
  85. ActiveSheet.Range("$A$1:A" & (Lastrow)).RemoveDuplicates Columns:=1, Header:=xlNo
  86. ws = ActiveSheet.Name
  87. rowCount = 1
  88. startcell = ("A1")
  89. Lastrow = Range("A" & Rows.Count).End(xlUp).Row
  90. Range(startcell, ("A" + (Lastrow))).Select
  91. ActiveSheet.ListObjects.Add(xlSrcRange, Range(startcell, ("A" + (Lastrow))), , xlNo).Name = _
  92. "Table2"
  93. Range("Table2[[#All],[Column1]]").Select
  94. ActiveSheet.ListObjects("Table2").TableStyle = "TableStyleLight1"
  95. ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort.SortFields.Clear
  96. ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort.SortFields.Add _
  97. Key:=Range("Table2[[#All],[Column1]]"), SortOn:=xlSortOnValues, Order:= _
  98. xlAscending, DataOption:=xlSortTextAsNumbers
  99. With ActiveWorkbook.Worksheets(ws).ListObjects("Table2").Sort
  100. .Header = xlYes
  101. .MatchCase = False
  102. .Orientation = xlTopToBottom
  103. .SortMethod = xlPinYin
  104. .Apply
  105. End With
  106. Range("B2").Select
  107. ActiveCell.FormulaR1C1 = "=MATCH([@Column1],'OUTLOOK DATA'!C[-1],0)"
  108. rowCount = 1
  109. startcell = ("A2")
  110. Lastrow = Range("A" & Rows.Count).End(xlUp).Row
  111. For Each i In Range(startcell, ("A" + (Lastrow)))
  112. rowCount = rowCount + 1
  113. Nwo = Cells((rowCount), 1).Value
  114. Firstrow = Cells((rowCount), 2).Value
  115. Secondrow = (Firstrow) + 1
  116. Sheets("OUTLOOK DATA").Select
  117. WO1 = Range("A" & (Firstrow))
  118. WO2 = Range("A" & (Secondrow))
  119. ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
  120. (Nwo)
  121. Range("A" & (Firstrow)).Select
  122. WOlastROW = Selection.End(xlDown).Row
  123. If (WO1) = (WO2) Then
  124. Range("C" & (WOlastROW)).Select
  125. Selection.Copy
  126. Range("C" & (Firstrow)).Select
  127. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  128. :=False, Transpose:=False
  129. End If
  130. ActiveSheet.ShowAllData
  131. Sheets("Sheet1").Select
  132. Next i
  133. Sheets("OUTLOOK DATA").Select
  134. Application.CutCopyMode = False
  135. ActiveSheet.Range("Table1[#All]").RemoveDuplicates Columns:=1, Header:= _
  136. xlYes
  137. ActiveWorkbook.Worksheets("OUTLOOK DATA").ListObjects("Table1").Sort. _
  138. SortFields.Clear
  139. ActiveWorkbook.Worksheets("OUTLOOK DATA").ListObjects("Table1").Sort. _
  140. SortFields.Add2 Key:=Range("Table1[[#All],[Subject]]"), SortOn:= _
  141. xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
  142. <details>
  143. <summary>英文:</summary>
  144. 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; &quot;Add Delay Code&quot; and &quot;Remove Delay Code&quot;? I believe I can achieve the need by updating the existing &quot;Delay Code&quot; field in Column G to &quot;Add Delay Code&quot; and shift the Columns H, I and J to the right so that Column H can become the new &quot;Remove Delay Code&quot; column. However, I&#39;m a complete VBA n00b and I don&#39;t know where to start.
  145. Sub Macro2()
  146. &#39;
  147. &#39; Macro2 Macro
  148. &#39;
  149. Dim startcell As String
  150. Dim Lastrow As String
  151. Dim Lastrow2 As String
  152. Dim rowCount As Integer
  153. Dim ws As String
  154. Dim Nws As String
  155. Dim Nwo As String
  156. Dim Firstcell As Integer
  157. Dim Lastcell As String
  158. Dim Firstrow As Integer
  159. Dim WO1 As String
  160. Dim WO2 As String
  161. Dim WOlastROW As String
  162. Dim StartTime As Date, EndTime As Date
  163. Dim TimeTaken As Double
  164. &#39;
  165. &#39;StartTime = Time
  166. Application.EnableEvents = False
  167. Application.ScreenUpdating = False
  168. GetUserName = Application.UserName
  169. Sheets(&quot;OUTLOOK DATA&quot;).Visible = True
  170. Sheets(&quot;OUTLOOK DATA&quot;).Select
  171. Range(&quot;A1&quot;).Select
  172. Lastrow = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
  173. Lastcell = &quot;V&quot; &amp; (Lastrow)
  174. Selection.AutoFilter
  175. ActiveSheet.Range(&quot;$A$1:&quot; &amp; (Lastcell)).AutoFilter Field:=1, Criteria1:= _
  176. &quot;=*Crew*&quot;, Operator:=xlAnd
  177. Rows(&quot;2:2&quot;).Select
  178. Range(Selection, Selection.End(xlDown)).Select
  179. Selection.Delete Shift:=xlUp
  180. ActiveSheet.ShowAllData
  181. Range(&quot;A1&quot;).Select
  182. Selection.AutoFilter
  183. Columns(&quot;C:C&quot;).Select
  184. Selection.Delete Shift:=xlToLeft
  185. Columns(&quot;D:M&quot;).Select
  186. Selection.Delete Shift:=xlToLeft
  187. Columns(&quot;E:K&quot;).Select
  188. Selection.Delete Shift:=xlToLeft
  189. Columns(&quot;A:D&quot;).EntireColumn.AutoFit
  190. Columns(&quot;A:A&quot;).Select
  191. Selection.TextToColumns Destination:=Range(&quot;F1&quot;), DataType:=xlFixedWidth, _
  192. OtherChar:=&quot;-&quot;, FieldInfo:=Array(Array(0, 1), Array(9, 1)), _
  193. TrailingMinusNumbers:=True
  194. Columns(&quot;G:G&quot;).Select
  195. Selection.Delete Shift:=xlToLeft
  196. Columns(&quot;F:F&quot;).Select
  197. Application.CutCopyMode = False
  198. Selection.Copy
  199. Columns(&quot;A:A&quot;).Select
  200. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  201. :=False, Transpose:=False
  202. Columns(&quot;F:F&quot;).Select
  203. Application.CutCopyMode = False
  204. Selection.Delete Shift:=xlToLeft
  205. Range(&quot;A1:E1&quot;).Select
  206. Range(Selection, Selection.End(xlDown)).Select
  207. Application.CutCopyMode = False
  208. Lastrow = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
  209. ActiveSheet.ListObjects.Add(xlSrcRange, Range(&quot;$A$1:$E&quot; &amp; (Lastrow)), , xlYes).Name = _
  210. &quot;Table1&quot;
  211. Range(&quot;Table1[#All]&quot;).Select
  212. ActiveSheet.ListObjects(&quot;Table1&quot;).TableStyle = &quot;TableStyleMedium2&quot;
  213. Columns(&quot;A:D&quot;).EntireColumn.AutoFit
  214. Sheets.Add After:=ActiveSheet
  215. Sheets(&quot;OUTLOOK DATA&quot;).Select
  216. Range(&quot;A2&quot;).Select
  217. Range(Selection, Selection.End(xlDown)).Select
  218. Application.CutCopyMode = False
  219. Selection.Copy
  220. Sheets(&quot;Sheet1&quot;).Select
  221. Range(&quot;A1&quot;).Select
  222. ActiveSheet.Paste
  223. Application.CutCopyMode = False
  224. ws = ActiveSheet.Name
  225. rowCount = 1
  226. startcell = (&quot;A1&quot;)
  227. Lastrow = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
  228. Range(startcell, (&quot;A&quot; + (Lastrow))).Select
  229. ActiveSheet.Range(&quot;$A$1:A&quot; &amp; (Lastrow)).RemoveDuplicates Columns:=1, Header:=xlNo
  230. ws = ActiveSheet.Name
  231. rowCount = 1
  232. startcell = (&quot;A1&quot;)
  233. Lastrow = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
  234. Range(startcell, (&quot;A&quot; + (Lastrow))).Select
  235. ActiveSheet.ListObjects.Add(xlSrcRange, Range(startcell, (&quot;A&quot; + (Lastrow))), , xlNo).Name = _
  236. &quot;Table2&quot;
  237. Range(&quot;Table2[[#All],[Column1]]&quot;).Select
  238. ActiveSheet.ListObjects(&quot;Table2&quot;).TableStyle = &quot;TableStyleLight1&quot;
  239. ActiveWorkbook.Worksheets(ws).ListObjects(&quot;Table2&quot;).Sort.SortFields.Clear
  240. ActiveWorkbook.Worksheets(ws).ListObjects(&quot;Table2&quot;).Sort.SortFields.Add _
  241. Key:=Range(&quot;Table2[[#All],[Column1]]&quot;), SortOn:=xlSortOnValues, Order:= _
  242. xlAscending, DataOption:=xlSortTextAsNumbers
  243. With ActiveWorkbook.Worksheets(ws).ListObjects(&quot;Table2&quot;).Sort
  244. .Header = xlYes
  245. .MatchCase = False
  246. .Orientation = xlTopToBottom
  247. .SortMethod = xlPinYin
  248. .Apply
  249. End With
  250. Range(&quot;B2&quot;).Select
  251. ActiveCell.FormulaR1C1 = &quot;=MATCH([@Column1],&#39;OUTLOOK DATA&#39;!C[-1],0)&quot;
  252. rowCount = 1
  253. startcell = (&quot;A2&quot;)
  254. Lastrow = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row
  255. For Each i In Range(startcell, (&quot;A&quot; + (Lastrow)))
  256. rowCount = rowCount + 1
  257. Nwo = Cells((rowCount), 1).Value
  258. Firstrow = Cells((rowCount), 2).Value
  259. Secondrow = (Firstrow) + 1
  260. Sheets(&quot;OUTLOOK DATA&quot;).Select
  261. WO1 = Range(&quot;A&quot; &amp; (Firstrow))
  262. WO2 = Range(&quot;A&quot; &amp; (Secondrow))
  263. ActiveSheet.ListObjects(&quot;Table1&quot;).Range.AutoFilter Field:=1, Criteria1:= _
  264. (Nwo)
  265. Range(&quot;A&quot; &amp; (Firstrow)).Select
  266. WOlastROW = Selection.End(xlDown).Row
  267. If (WO1) = (WO2) Then
  268. Range(&quot;C&quot; &amp; (WOlastROW)).Select
  269. Selection.Copy
  270. Range(&quot;C&quot; &amp; (Firstrow)).Select
  271. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  272. :=False, Transpose:=False
  273. End If
  274. ActiveSheet.ShowAllData
  275. Sheets(&quot;Sheet1&quot;).Select
  276. Next i
  277. Sheets(&quot;OUTLOOK DATA&quot;).Select
  278. Application.CutCopyMode = False
  279. ActiveSheet.Range(&quot;Table1[#All]&quot;).RemoveDuplicates Columns:=1, Header:= _
  280. xlYes
  281. ActiveWorkbook.Worksheets(&quot;OUTLOOK DATA&quot;).ListObjects(&quot;Table1&quot;).Sort. _
  282. SortFields.Clear
  283. ActiveWorkbook.Worksheets(&quot;OUTLOOK DATA&quot;).ListObjects(&quot;Table1&quot;).Sort. _
  284. SortFields.Add2 Key:=Range(&quot;Table1[[#All],[Subject]]&quot;), SortOn:= _
  285. xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
  286. With ActiveWorkbook.Worksheets(&quot;OUTLOOK DATA&quot;).ListObjects(&quot;Table1&quot;). _
  287. Sort
  288. .Header = xlYes
  289. .MatchCase = False
  290. .Orientation = xlTopToBottom
  291. .SortMethod = xlPinYin
  292. .Apply
  293. End With
  294. Columns(&quot;B:C&quot;).Select
  295. Selection.NumberFormat = &quot;m/d/yy;@&quot;
  296. Range(&quot;Table1[[#Headers],[Subject]]&quot;).Select
  297. Application.CutCopyMode = False
  298. ActiveCell.FormulaR1C1 = &quot;Order&quot;
  299. Range(&quot;Table1[[#Headers],[Start Date]]&quot;).Select
  300. ActiveCell.FormulaR1C1 = &quot;Start&quot;
  301. Range(&quot;Table1[[#Headers],[End Date]]&quot;).Select
  302. ActiveCell.FormulaR1C1 = &quot;Finish&quot;
  303. Range(&quot;Table1[[#Headers],[column1]]&quot;).Select
  304. ActiveCell.FormulaR1C1 = &quot;SCH Grade&quot;
  305. Range(&quot;E2&quot;).Select
  306. ActiveCell.Formula2R1C1 = &quot;=IFS(ISNUMBER(SEARCH(&quot;&quot;Hard Date&quot;&quot;,[@Categories],1)),&quot;&quot;B&quot;&quot;,ISNUMBER(SEARCH(&quot;&quot;Firm Date&quot;&quot;,[@Categories],1)),&quot;&quot;C&quot;&quot;,ISNUMBER(SEARCH(&quot;&quot;Flex Date&quot;&quot;,[@Categories],1)),&quot;&quot;D&quot;&quot;)&quot;
  307. Range(&quot;Table1[SCH Grade]&quot;).Select
  308. Selection.Copy
  309. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  310. :=False, Transpose:=False
  311. Cells.Replace What:=&quot;#N/A&quot;, Replacement:=&quot;D&quot;, LookAt:=xlPart, _
  312. SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
  313. ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
  314. Columns(&quot;D:D&quot;).Select
  315. Application.CutCopyMode = False
  316. Selection.Delete Shift:=xlToLeft
  317. Sheets(&quot;SAP DATA&quot;).Select
  318. Range(&quot;Activity[[#Headers],[Suboperation]]&quot;) = &quot;Start&quot;
  319. Range(&quot;Activity[[#Headers],[MaintenancePlan]]&quot;) = &quot;Finish&quot;
  320. Range(&quot;Activity[[#Headers],[SystemCondition]]&quot;) = &quot;Update User Status&quot;
  321. Range(&quot;Activity[[#Headers],[Description]]&quot;) = &quot;SCH Grade Update&quot;
  322. Range(&quot;Activity[[#Headers],[Op.short text]]&quot;) = &quot;Delay Code&quot;
  323. Range(&quot;Activity[[#Headers],[Op.System Cond.]]&quot;) = &quot;Scheduler&quot;
  324. Range(&quot;C2:G3&quot;).Select
  325. Range(Selection, Selection.End(xlDown)).Select
  326. Selection.ClearContents
  327. Columns(&quot;E:G&quot;).NumberFormat = &quot;General&quot;
  328. Columns(&quot;C:D&quot;).NumberFormat = &quot;m/d/yy;@&quot;
  329. &#39;Range(&quot;C2&quot;).Select
  330. Range(&quot;C2&quot;).FormulaR1C1 = &quot;=VLOOKUP([@Order],Table1,2,FALSE)&quot;
  331. &#39;Columns(&quot;C:C&quot;).Select
  332. &#39;Range(&quot;D2&quot;).Select
  333. Range(&quot;D2&quot;).FormulaR1C1 = &quot;=VLOOKUP([@Order],Table1,3,FALSE)&quot;
  334. &#39;Range(&quot;E2&quot;).Select
  335. Range(&quot;E2&quot;).FormulaR1C1 = &quot;=IF(LEFT([@[User status]],3)=&quot;&quot;RSC&quot;&quot;,&quot;&quot;Yes&quot;&quot;,&quot;&quot;No&quot;&quot;)&quot;
  336. &#39;Range(&quot;F2&quot;).Select
  337. Range(&quot;F2&quot;).FormulaR1C1 = &quot;=VLOOKUP([@Order],Table1,4,FALSE)&quot;
  338. Range(&quot;Activity[[#Headers],[Order]:[Scheduler]]&quot;).Select
  339. Range(Selection, Selection.End(xlDown)).Select
  340. Selection.Copy
  341. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  342. :=False, Transpose:=False
  343. With Selection.Interior
  344. .Pattern = xlNone
  345. .TintAndShade = 0
  346. .PatternTintAndShade = 0
  347. End With
  348. Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  349. Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  350. With Selection.Borders(xlEdgeLeft)
  351. .LineStyle = xlContinuous
  352. .ColorIndex = 0
  353. .TintAndShade = 0
  354. .Weight = xlThin
  355. End With
  356. With Selection.Borders(xlEdgeTop)
  357. .LineStyle = xlContinuous
  358. .ColorIndex = 0
  359. .TintAndShade = 0
  360. .Weight = xlThin
  361. End With
  362. With Selection.Borders(xlEdgeBottom)
  363. .LineStyle = xlContinuous
  364. .ColorIndex = 0
  365. .TintAndShade = 0
  366. .Weight = xlThin
  367. End With
  368. With Selection.Borders(xlEdgeRight)
  369. .LineStyle = xlContinuous
  370. .ColorIndex = 0
  371. .TintAndShade = 0
  372. .Weight = xlThin
  373. End With
  374. With Selection.Borders(xlInsideVertical)
  375. .LineStyle = xlContinuous
  376. .ColorIndex = 0
  377. .TintAndShade = 0
  378. .Weight = xlThin
  379. End With
  380. With Selection.Borders(xlInsideHorizontal)
  381. .LineStyle = xlContinuous
  382. .ColorIndex = 0
  383. .TintAndShade = 0
  384. .Weight = xlThin
  385. End With
  386. Columns(&quot;I:K&quot;).Select
  387. Selection.ClearContents
  388. Selection.NumberFormat = &quot;General&quot;
  389. Range(&quot;Activity[[#Headers],[Column1]]&quot;).Select
  390. ActiveCell.FormulaR1C1 = &quot;Delete&quot;
  391. Range(&quot;I2&quot;).Select
  392. ActiveCell.FormulaR1C1 = &quot;=IF([@Start]=[@[Earl.start date]],&quot;&quot;YES&quot;&quot;,&quot;&quot;&quot;&quot;)&quot;
  393. Range(&quot;Activity[[#Headers],[Column2]]&quot;).Select
  394. ActiveCell.FormulaR1C1 = &quot;Check&quot;
  395. Range(&quot;J2&quot;).Select
  396. ActiveCell.FormulaR1C1 = &quot;=IF([@Finish]=[@EarliestEndDate],&quot;&quot;YES&quot;&quot;,&quot;&quot;&quot;&quot;)&quot;
  397. Range(&quot;Activity[[#Headers],[Column3]]&quot;).Select
  398. ActiveCell.FormulaR1C1 = &quot;Goodbye&quot;
  399. Range(&quot;K2&quot;).Select
  400. ActiveCell.FormulaR1C1 = &quot;=COUNTIFS([@[Update User Status]],&quot;&quot;No&quot;&quot;,[@Delete],&quot;&quot;YES&quot;&quot;,[@Check],&quot;&quot;YES&quot;&quot;)&quot;
  401. Sheets(&quot;Sheet1&quot;).Select
  402. Range(&quot;AA1&quot;).Select
  403. ActiveCell.FormulaR1C1 = &quot;=COUNTIF(Activity[Goodbye],1)&quot;
  404. Sheets(&quot;SAP DATA&quot;).Select
  405. If Sheets(&quot;Sheet1&quot;).Range(&quot;AA1&quot;) &gt; 0 Then
  406. ActiveWorkbook.Worksheets(&quot;SAP DATA&quot;).ListObjects(&quot;Activity&quot;).Sort.SortFields. _
  407. Clear
  408. ActiveWorkbook.Worksheets(&quot;SAP DATA&quot;).ListObjects(&quot;Activity&quot;).Sort.SortFields. _
  409. Add2 Key:=Range(&quot;Activity[[#All],[Goodbye]]&quot;), SortOn:=xlSortOnValues, _
  410. Order:=xlDescending, DataOption:=xlSortTextAsNumbers
  411. With ActiveWorkbook.Worksheets(&quot;SAP DATA&quot;).ListObjects(&quot;Activity&quot;).Sort
  412. .Header = xlYes
  413. .MatchCase = False
  414. .Orientation = xlTopToBottom
  415. .SortMethod = xlPinYin
  416. .Apply
  417. End With
  418. ActiveSheet.ListObjects(&quot;Activity&quot;).Range.AutoFilter Field:=11, Criteria1:= _
  419. &quot;1&quot;
  420. Rows(&quot;2:2&quot;).Select
  421. Range(Selection, Selection.End(xlDown)).Select
  422. Application.CutCopyMode = False
  423. Selection.Delete Shift:=xlUp
  424. ActiveSheet.ShowAllData
  425. End If
  426. Range(&quot;A2&quot;).Select
  427. Columns(&quot;I:I&quot;).Select
  428. Range(Selection, Selection.End(xlToRight)).Select
  429. Application.CutCopyMode = False
  430. Selection.Delete Shift:=xlToLeft
  431. Range(&quot;Activity[Scheduler]&quot;) = GetUserName
  432. Columns(&quot;A:H&quot;).EntireColumn.AutoFit
  433. Range(&quot;J2&quot;).Select
  434. ActiveCell.FormulaR1C1 = _
  435. &quot;S:\LDC-LI\Central Scheduling Folder\Outlook Exports\Bot Intake Form&quot;
  436. Range(&quot;J1&quot;).Select
  437. ActiveCell.FormulaR1C1 = &quot;Copy data to file destination below&quot;
  438. Range(&quot;J1:J2&quot;).Select
  439. With Selection
  440. .HorizontalAlignment = xlGeneral
  441. .VerticalAlignment = xlCenter
  442. .WrapText = False
  443. .Orientation = 0
  444. .AddIndent = False
  445. .IndentLevel = 0
  446. .ShrinkToFit = False
  447. .ReadingOrder = xlContext
  448. .MergeCells = False
  449. End With
  450. With Selection
  451. .HorizontalAlignment = xlCenter
  452. .VerticalAlignment = xlCenter
  453. .WrapText = False
  454. .Orientation = 0
  455. .AddIndent = False
  456. .IndentLevel = 0
  457. .ShrinkToFit = False
  458. .ReadingOrder = xlContext
  459. .MergeCells = False
  460. End With
  461. Range(&quot;J1&quot;).Select
  462. With Selection.Interior
  463. .Pattern = xlSolid
  464. .PatternColorIndex = xlAutomatic
  465. .ThemeColor = xlThemeColorAccent4
  466. .TintAndShade = 0.399975585192419
  467. .PatternTintAndShade = 0
  468. End With
  469. Range(&quot;J1:J2&quot;).Select
  470. Selection.Borders(xlDiagonalDown).LineStyle = xlNone
  471. Selection.Borders(xlDiagonalUp).LineStyle = xlNone
  472. With Selection.Borders(xlEdgeLeft)
  473. .LineStyle = xlContinuous
  474. .ColorIndex = 0
  475. .TintAndShade = 0
  476. .Weight = xlThin
  477. End With
  478. With Selection.Borders(xlEdgeTop)
  479. .LineStyle = xlContinuous
  480. .ColorIndex = 0
  481. .TintAndShade = 0
  482. .Weight = xlThin
  483. End With
  484. With Selection.Borders(xlEdgeBottom)
  485. .LineStyle = xlContinuous
  486. .ColorIndex = 0
  487. .TintAndShade = 0
  488. .Weight = xlThin
  489. End With
  490. With Selection.Borders(xlEdgeRight)
  491. .LineStyle = xlContinuous
  492. .ColorIndex = 0
  493. .TintAndShade = 0
  494. .Weight = xlThin
  495. End With
  496. With Selection.Borders(xlInsideVertical)
  497. .LineStyle = xlContinuous
  498. .ColorIndex = 0
  499. .TintAndShade = 0
  500. .Weight = xlThin
  501. End With
  502. With Selection.Borders(xlInsideHorizontal)
  503. .LineStyle = xlContinuous
  504. .ColorIndex = 0
  505. .TintAndShade = 0
  506. .Weight = xlThin
  507. End With
  508. Columns(&quot;J:J&quot;).Select
  509. Selection.ColumnWidth = 75
  510. Range(&quot;Activity[[#Headers],[Order]]&quot;).Select
  511. Range(&quot;Activity[[#Headers],[Order]]&quot;).Select
  512. Sheets(&quot;Macro Controls&quot;).Select
  513. ActiveWindow.SelectedSheets.Delete
  514. Sheets(&quot;Sheet1&quot;).Select
  515. ActiveWindow.SelectedSheets.Delete
  516. Sheets(&quot;OUTLOOK DATA&quot;).Select
  517. ActiveWindow.SelectedSheets.Delete
  518. Application.EnableEvents = True
  519. Application.ScreenUpdating = True
  520. &#39;EndTime = Time
  521. SAVE
  522. &#39;TimeTaken = (EndTime - StartTime) * 24 * 60 * 60
  523. &#39;MsgBox TimeTaken
  524. End Sub
  525. Private Sub SAVE()
  526. &#39;
  527. &#39; Creating a new book in which to place schedules
  528. &#39; Thanks Shawn for your Googling expertise 12-12-17
  529. &#39; Tuesday is officially &quot;BREAKTHROUGH DAY&quot;
  530. USID = Environ(&quot;UserName&quot;)
  531. ActiveWorkbook.SaveAs Filename:=&quot;C:\Users\&quot; &amp; (USID) &amp; &quot;\Desktop\&quot; &amp; &quot;BOT DATA DROP&quot; &amp; &quot;.xlsx&quot;, FileFormat _
  532. :=xlOpenXMLWorkbook, Password:=&quot;&quot;, WriteResPassword:=&quot;&quot;, ReadOnlyRecommended:= _
  533. False, CreateBackup:=False
  534. End Sub
  535. Sub GetWorkorderNumbers()
  536. Dim Lastrow As String
  537. Dim NewLastrow As String
  538. &#39;
  539. Sheets(&quot;Outlook Data&quot;).Select
  540. Columns(&quot;A:A&quot;).Select
  541. Selection.TextToColumns Destination:=Range(&quot;AA1&quot;), DataType:=xlDelimited, _
  542. TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
  543. Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
  544. &quot;&amp;&quot;, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), _
  545. Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers _
  546. :=True
  547. Columns(&quot;B:B&quot;).Select
  548. Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
  549. Columns(&quot;AB:AC&quot;).Select
  550. Selection.Copy
  551. Range(&quot;A1:B1&quot;).Select
  552. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  553. :=False, Transpose:=False
  554. Range(&quot;B1&quot;).Select
  555. ActiveCell.FormulaR1C1 = &quot;2nd WO&quot;
  556. Columns(&quot;AB:AB&quot;).Select
  557. Range(Selection, Selection.End(xlToRight)).Select
  558. Application.CutCopyMode = False
  559. Selection.Delete Shift:=xlToLeft
  560. Lastrow = Range(&quot;A&quot; &amp; Rows.Count).End(xlUp).Row + 1
  561. Range(&quot;B2:W&quot; &amp; Lastrow).Select
  562. Selection.Copy
  563. Range(&quot;B&quot; &amp; Lastrow).Select
  564. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  565. :=False, Transpose:=False
  566. NewLastrow = Range(&quot;C&quot; &amp; Rows.Count).End(xlUp).Row
  567. Range(&quot;B&quot; &amp; Lastrow &amp; &quot;:B&quot; &amp; NewLastrow).Select
  568. Selection.Copy
  569. Range(&quot;A&quot; &amp; Lastrow).Select
  570. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  571. :=False, Transpose:=False
  572. Columns(&quot;B:B&quot;).Select
  573. Application.CutCopyMode = False
  574. Selection.Delete Shift:=xlToLeft
  575. Sheets(&quot;Macro Controls&quot;).Select
  576. Range(&quot;A:A&quot;).EntireColumn.Hidden = False
  577. ActiveSheet.ListObjects(&quot;WOnumbers&quot;).Range.AutoFilter Field:=1, Criteria1:= _
  578. &quot;&lt;&gt;1*&quot;, Operator:=xlOr, Criteria2:=&quot;=&quot;
  579. Range(&quot;A2&quot;).Select
  580. Range(Selection, Selection.End(xlDown)).Select
  581. Selection.EntireRow.Delete
  582. ActiveSheet.ListObjects(&quot;WOnumbers&quot;).Range.AutoFilter Field:=1
  583. Range(&quot;A2&quot;).Select
  584. ActiveSheet.Range(&quot;WOnumbers[#All]&quot;).RemoveDuplicates Columns:=1, Header:= _
  585. xlYes
  586. Range(&quot;A2&quot;).Select
  587. Range(Selection, Selection.End(xlDown)).Select
  588. Selection.Copy
  589. Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  590. :=False, Transpose:=False
  591. Range(&quot;WOnumbers[[#Headers],[Order Numbers]]&quot;).Select
  592. Sheets(&quot;OUTLOOK DATA&quot;).Visible = False
  593. Sheets(&quot;SAP DATA&quot;).Visible = True
  594. End Sub
  595. I&#39;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 &#39;part 2&#39; macros I have to another &#39;part 1&#39; macros that formats data from Microsoft Outlook to align with data that comes from SAP in &#39;part 2&#39;.
  596. </details>
  597. # 答案1
  598. **得分**: 1
  599. 我不知道这是否是你所面对的问题（因为坦白说，我不打算尝试理解你的代码 - 这么长的代码块实在太多了 - 这样长的过程实际上不应该存在，通常你会尝试将不同的功能拆分成子程序和函数）。
  600. 但现在我认为可能存在的问题是，当插入时，你正在改变列的位置。如果你在A列之后插入1列，那么列B现在将成为列C，依此类推。这将破坏对列B或C（或任何大于A的其他列）的可能引用 - 这就是为什么在插入行和列时，通常从最大的开始，然后从那里往回工作的原因。例如，假设你想在A、D和F之后插入一列。那么你应该首先在F之后插入列，然后是D，最后是A。这样，后续的插入操作将不会受到其他插入操作引起的列的移动的影响。
  601. <details>
  602. <summary>英文:</summary>
  603. I don&#39;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&#39;t really exist, you&#39;d usually try and split different functionalities into subs and functions.)
  604. 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&#39;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.
  605. </details>

huangapple
  • 本文由 发表于 2023年6月1日 09:40:03
  • 转载请务必保留本文链接：https://go.coder-hub.com/76378179.html
  • excel
  • vba
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定