VBA – 意外的行插入

目的

复制多个工作表中的一组行并插入到CONSOLIDATED工作表中。

APPROACH

  1. 转到CONSOLIDATED工作表并删除预先存在的信息
  2. 使用IF语句查找我们打算从中提取数据的相关工作表
  3. 复制每个工作表上相关的列和行(例如A6:G(lastrow))
  4. 追加复制的数据到CONSOLIDATED工作表!!!错误

(丑)代码

 Sub consolidateConvert() Dim ws As Worksheet 'Set CONSOLIDATED as the active worksheet Application.ScreenUpdating = False Sheets("CONSOLIDATED").Activate 'Clear previous content from active sheet ActiveSheet.Range("A1:G10000").ClearContents 'Iterate through workbooks, except for CONSOLIDATED, TITLE, and PIVOT worksheets For Each ws In Worksheets If ws.Name <> "CONSOLIDATED" And ws.Name <> "PIVOT" And ws.Name <> "TITLE" _ And ws.Name <> "APPENDIX - CURRENCY CONVERTER" And ws.Name <> "MACRO" Then 'Find last row of current worksheet Dim lastRow As Long lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row 'Copy current worksheet cells and insert into CONSOLIDATED worksheet ws.Range("A6:G" & lastRow).Copy ActiveSheet.Range("A2").End(xlUp).Insert shift:=xlDown End If Next ws Call currencyConvert Call addHeaders 

currencyConvert是一个与这个特定问题无关的函数。 不过,我在下面添加了addHeaders函数:

 Sub addHeaders() Dim ws As Worksheet Dim headers() As Variant 'Define worksheet and desired headers Set ws = ThisWorkbook.Sheets("CONSOLIDATED") headers() = Array("Fiscal Year", "Month", "Fiscal Month", "Month Year", "Unit", "Project", "Local Expense", "Base Expense") 'Insert row for header placement Rows(1).Insert shift:=xlShiftDown 'Insert headers With ws For i = LBound(headers()) To UBound(headers()) .Cells(1, 1 + i).Value = headers(i) Next i End With End Sub 

OUTPUT

以下是意外输出的截图。 第2-7行是意想不到的,并且包括一些随机的文本string,不存在于工作簿中的其他任何地方。 string可能是VBA中的一些奇怪的inheritance问题,但不太确定(因此下面的问题)。

奇怪的文本字符串错误

质询

  1. 如前所述,第2-7行是无意中添加的,并伴随着一些奇怪的string。 有没有人有任何见解,为什么addHeaders()行正在添加(当只有1应该被添加 – 见addHeaders() )? 另外,无意的string(“CatalogNickname”,“EnvironmentKey”等)的起源是什么?

你的问题来自使用Activate / ActiveSheet

你必须放弃这种编码习惯,这可以巧妙地误导你,并使用完全合格的范围参考,以确保您的行为在所需的工作簿/工作表范围

这里遵循一个重构你的代码与这样的完全合格的范围引用和“值到值” range副本而不是一个Copy / Insert来显着加快速度:

 Option Explicit Sub consolidateConvert() Dim ws As Worksheet Dim lastRow As Long With Worksheets("CONSOLIDATED") '<--| reference "CONSOLIDATED" worksheet .UsedRange.ClearContents '<--| clear its content 'Iterate through workbooks For Each ws In Worksheets Select Case ws.Name Case "CONSOLIDATED", "PIVOT", "TITLE", "APPENDIX - CURRENCY CONVERTER", "MACRO" ' <--| discard "CONSOLIDATED", "TITLE", "PIVOT", "APPENDIX - CURRENCY CONVERTER" and "MACRO" worksheets ' do nothing Case Else 'Find last row of current worksheet lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).row 'Copy current worksheet cells and insert into CONSOLIDATED worksheet .Cells(.Rows.Count, 1).End(xlUp).Offset(1).Resize(lastRow - 5, 7).Value = ws.Range("A6:G" & lastRow).Value '<--| just copy values and speed thing up! End Select Next ws addHeaders .Name '<--| call AddHeaders passing reference worksheet name (ie "CONSOLIDATED") End With currencyConvert '<--| if it acts on "CONSOLIDATED" sheet, you may want to "treat" it as 'addHeaders': take it into 'End With' and pass it '.Name' as a parameter End Sub Sub addHeaders(shtName As String) Dim headers As Variant headers = Array("Fiscal Year", "Month", "Fiscal Month", "Month Year", "Unit", "Project", "Local Expense", "Base Expense") '<--| Define desired headers ThisWorkbook.Worksheets(shtName).Range("A1").Resize(, UBound(headers) - LBound(headers) + 1).Value = headers '<--| write headers from cell A1 rightwards End Sub