Range.Rows = 2的循环中断 – VBA
我将继续扩展从大型机中分类和组织数据的function。 这个问题是关于从这个问题的焦点扩大function。 这些数据是字母数字的，与前面提到的问题类似。
我试图允许用户使用我的数据集的标准表中的一个项目的列表，以及多个项目。 我的代码如下：
'This subroutine is intended to take filtered data and use it to fill forms. 'These forms use a very basic text template worksheet, which is copied over for each worksheet. 'In general, these forms will number from 1 to 100, for discussion purposes. 'The idea is that each row of data in the DataSheet will be used to fill each worksheet tab. Sub Shifter() Dim RngOne As Range, RngCell As Range Dim RngTwo As Range Dim RngThree As Range, RngCell2 As Range 'RngCell2 is not currently in use Dim RngRow As Range Dim LastCell As Long Dim arrList() As String, LongCount As Long 'Define range data within the Criteria Sheet With Sheets("Criteria") LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row If LastCell <= 1 Then MsgBox ("Please do not leave the Criteria sheet blank. Note that all criteria belong under Column A.") Exit Sub ElseIf LastCell = 2 Then Set RngOne = .Range("A2") Else Set RngOne = .Range("A2:A" & LastCell) End If End With 'Push values into the array LongCount = 0 For Each RngCell In RngOne ReDim Preserve arrList(LongCount) arrList(LongCount) = RngCell.Text LongCount = LongCount + 1 Next 'Filter the values to the desired criteria stored in the array. With Sheets("Sheet1") LastSheetCellCheck = .Range("A" & Sheets("Sheet1").Rows.Count).End(xlUp).Row If LastCell <= 1 Then MsgBox ("Please do not leave the Criteria sheet blank. Note that all criteria belong under Column A.") Exit Sub End If Call ShiftToText 'For when this process is repeated. If .FilterMode Then .ShowAllData .Range("A:A").AutoFilter Field:=1, Criteria1:=arrList, Operator:=xlFilterValues End With 'Add a Sheet to contain the filtered criteria Sheets.Add After:=Sheets(1) Sheets(2).Name = "DataSheet" 'With the original dataset, snag all existing data based on the range in Sheet Criteria. 'This avoids potential empty junk data and potential blanks pulled from the mainframe. With Sheets("Sheet1") LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row Set RngTwo = .Range("A2:AA" & LastCell) End With 'Push data into DataSheet worksheet, so data is sequential Sheets(1).Select RngTwo.Copy Sheets("DataSheet").Select ActiveSheet.Paste 'Define the ranges used within the sheet With Sheets("DataSheet") If LastCell = 2 Then Set RngThree = .Range("A2") Else LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row Set RngThree = .Range("A2:A" & LastCell) End If End With 'For each row in the range, (1) generate a new datasheet, and copy the form from the template to the new sheet. '(2) Rename the datasheet to be the value in Row 1, Column 1 ("A1"). '(3) Copy over information to the form based on column location in the Datasheet. 'This method, even if made functional, is both procedural and limited in scope. Recursion with text matching will be the end goal for this form. For Each RngRow In RngThree.Rows Sheets.Add After:=Sheets(1) 'Grab the text form from the Template and push it into the new sheet. Sheets("TemplateSheet").Select Cells.Select Selection.Copy Sheets(2).Select ActiveSheet.Paste Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value Sheets(2).Range("B3").Value = Sheets("DataSheet").Cells(RngRow.Row, 1).Value Sheets(2).Range("B5").Value = Sheets("DataSheet").Cells(RngRow.Row, 2).Value Sheets(2).Range("D3").Value = Sheets("DataSheet").Cells(RngRow.Row, 3).Value Sheets(2).Range("F3").Value = Sheets("DataSheet").Cells(RngRow.Row, 4).Value Sheets(2).Range("B10").Value = Sheets("DataSheet").Cells(RngRow.Row, 5).Value Sheets(2).Range("B7").Value = Sheets("DataSheet").Cells(RngRow.Row, 6).Value Sheets(2).Range("D10").Value = Sheets("DataSheet").Cells(RngRow.Row, 7).Value Sheets(2).Range("F10").Value = Sheets("DataSheet").Cells(RngRow.Row, 8).Value Sheets(2).Range("B13").Value = Sheets("DataSheet").Cells(RngRow.Row, 9).Value Sheets(2).Range("D13").Value = Sheets("DataSheet").Cells(RngRow.Row, 10).Value Sheets(2).Range("F13").Value = Sheets("DataSheet").Cells(RngRow.Row, 11).Value Sheets(2).Range("B16").Value = Sheets("DataSheet").Cells(RngRow.Row, 12).Value Sheets(2).Range("D16").Value = Sheets("DataSheet").Cells(RngRow.Row, 13).Value Sheets(2).Range("F16").Value = Sheets("DataSheet").Cells(RngRow.Row, 14).Value Sheets(2).Range("B19").Value = Sheets("DataSheet").Cells(RngRow.Row, 15).Value Sheets(2).Range("D19").Value = Sheets("DataSheet").Cells(RngRow.Row, 16).Value Sheets(2).Range("F19").Value = Sheets("DataSheet").Cells(RngRow.Row, 17).Value Sheets(2).Range("B21").Value = Sheets("DataSheet").Cells(RngRow.Row, 18).Value Sheets(2).Range("D21").Value = Sheets("DataSheet").Cells(RngRow.Row, 19).Value Sheets(2).Range("B23").Value = Sheets("DataSheet").Cells(RngRow.Row, 20).Value Sheets(2).Range("D23").Value = Sheets("DataSheet").Cells(RngRow.Row, 21).Value 'Concatenate values from certain fields into one field Sheets(2).Range("A26").Value = Sheets("DataSheet").Cells(RngRow.Row, 23).Value & Cells(RngRow.Row, 24).Value & Cells(RngRow.Row, 24).Value & Cells(RngRow.Row, 25).Value & Cells(RngRow.Row, 26).Value & Cells(RngRow.Row, 27).Value Next RngRow End Sub 目前，代码的执行导致第106行的“1004”运行时错误： Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value 。
尽可能避免On Error Resume代码块上，因为我认为它们是最后的手段，但是我处于一个死路一条，并且可以使用针对面向对象/通用VBA解决scheme的援助/build议。
编辑
要进一步说明，请添加简单的代码
MsgBox (Sheets(2).Name)
后
Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value
在Rng.Rows = 1时返回“A2”的“100-AAA”的testing值。此外，在代码执行开始时，通过调用由这个问题开发的删除脚本来移除testing表。 代码在Rng.Rows = 2时失败。
我想我find了你的答案
在你的代码中：
With Sheets("Sheet1") LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row Set RngTwo = .Range("A2:AA" & LastCell) End With 'Push data into DataSheet worksheet, so data is sequential Sheets(1).Select RngTwo.Copy Sheets("DataSheet").Select ActiveSheet.Paste
您Set RngTwo = .Range("A2:AA" & LastCell) ，这意味着您的标题粘贴到DataSheet时不包括在内。 然后在下面，这个块
If LastCell = 2 Then Set RngThree = .Range("A2")
将无法正常工作，因为您只复制了一行数据，因此A2是空白的。 您可能没有注意到，因为没有错误，但是这也意味着当条件大于1时，始终将DataSheet的第一个元素留在列表中。
有两个解决scheme，我看到它：更改LastCell检查设置范围从第1行开始：
If LastCell = 2 Then Set RngThree = .Range("A1") 'CHANGE THIS LINE Else LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row Set RngThree = .Range("A1:A" & LastCell) 'CHANGE THIS LINE End If
或者设置您的复制范围以包含第一个标题行：
With Sheets("Sheet1") LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).Row Set RngTwo = .Range("A1:AA" & LastCell) 'CHANGE THIS LINE End With 'Push data into DataSheet worksheet, so data is sequential Sheets(1).Select RngTwo.Copy Sheets("DataSheet").Select ActiveSheet.Paste
为了logging，我曾经用一个和多个标准testing了上述两个选项。 一切似乎都适合我。
我希望这有帮助…