Loop在Range.Rows = 2 - VBA [英] Loop Breaks On Range.Rows = 2 -- VBA

问题描述

我继续扩大排序和组织从主机提取的数据的功能。这个问题是关于从这个问题焦点。数据是字母数字，类似于此以前提及的问题中发现的数据。

我试图允许用户在我的数据集的标准表中使用1个项目的列表，以及多个项目。我的代码如下：

 '此子例程旨在获取已过滤的数据并使用它填写表单。 
'这些表单使用非常基本的文本模板工作表，这是每个工作表复制的。 
'一般来说，这些表格的编号从1到100，供讨论。 
'的想法是DataSheet中的每一行数据将用于填充每个工作表选项卡。 
 
 Sub Shifter（）
 
 
 Dim RngOne As Range，RngCell As Range 
 Dim RngTwo As Range 
 Dim RngThree As Range，RngCell2因为Range'RngCell2目前没有使用
 Dim RngRow As Range 
 
 Dim LastCell As Long 
 
 Dim arrList（）As String，LongCount As Long 
 
'在条件表中定义范围数据
带表格（条件）
 LastCell = .Range（A& Sheets（Criteria）。Rows.Count）。结束（xlUp）.Row 
如果LastCell <= 1然后
 MsgBox（请不要将条件表留空，请注意所有条件属于列A）
退出子
 ElseIf LastCell = 2然后
设置RngOne = .Range（A2）
 Else 
设置RngOne = .Range（A2：A& LastCell）
结束如果
结束
 
'将值推入数组
 LongCount = 0 
每个RngCell在RngOne 
 ReDim保留arrList（LongCount）
 arrList（LongCount）= RngCell.Text 
 L ongCount = LongCount + 1 
下一个
 
 
'将值过滤到存储在数组中的所需条件。 
带表格（Sheet1）
 
 LastSheetCellCheck = .Range（A& Sheets（Sheet1）。Rows.Count）.End（xlUp）.Row 
如果LastCell <= 1然后
 MsgBox（请不要将条件表留空，请注意所有条件属于列A）
退出子
结束If 
 
调用ShiftToText 
'对于何时重复此过程。 
 IfFilterMode Then .ShowAllData 
 
 .Range（A：A）。AutoFilter Field：= 1，Criteria1：= arrList，Operator：= xlFilterValues 
 
结束
 
'添加工作表以包含过滤的条件
 Sheets.Add After：= Sheets（1）
表（2）.Name =DataSheet
 
'使用原始数据集，根据表格条件范围内的所有现有数据。 
'这样可以避免潜在的空垃圾数据和潜在的空白从主机拉出来。 
 with Sheets（Sheet1）
 
 LastCell = .Range（A& Sheets（Criteria）。Rows.Count）.End（xlUp）.Row 
设置RngTwo = .Range（A2：AA& LastCell）
 
结束
 
'将数据推送到DataSheet工作表中，因此数据是顺序的
表（1）。选择
 RngTwo.Copy 
表格（DataSheet）。选择
 ActiveSheet.Paste 
 
'定义工作表内使用的范围
 With Sheets（DataSheet）
 
如果LastCell = 2然后
 
设置RngThree = .Range（A2）
 
 Else 
 
 LastCell = .Range（A& Sheets（Criteria）。Rows.Count）.End（xlUp）.Row 
设置RngThree = .Range（A2：A& ; LastCell）
 
结束如果
 
结束
 
'对于范围中的每一行，（1）生成一个新的数据表，并复制从模板到新表格。 
'（2）将数据表重命名为行1，列1（A1）中的值。 
'（3）根据数据表中的列位置将信息复制到表单。 
'这种方法即使功能齐全，也是程序性的，范围有限。带有文本匹配的递归将成为此表单的最终目标。 
每个RngRow在RngThree.Rows 
 
 Sheets.Add After：= Sheets（1）
 
'从模板中抓取文本格式并将其推入新表。 
表单（TemplateSheet）。选择
 Cells.Select 
 Selection.Copy 
表格（2）。选择
 ActiveSheet.Paste 
 
表格（2）.Name = Sheets（DataSheet）。Cells（RngRow.Row，1）.Value 
 
 Sheets（2）.Range（B3）。Value = Sheets数据表）。单元格（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 
 
表格（2）.Range（F3）。Value = Sheets（DataSheet）。Cells（RngRow.Row，4）.Value 
 
表格（2）.Range（B10） .Value = Sheets（DataSheet）。Cells（RngRow.Row，5）.Value 
 
 Sheets（2）.Range（B7）。Value = Sheets（DataSheet）。 （RngRow.Row，6）.Value 
 
 Sheets（2）.Range（D10）。Value = Sheets（DataSheet）。Cells（RngRow.Row，7）.Value 
 
表格（2）.Range（F10）。Value = Sheets（DataSheet）。Cells（RngRow.Row，8）.Value 
 
表格（2）。 Range（B13）。Value = Sheets（DataSheet）。Cells（RngRow.Row，9）.Value 
 
表格（2）.Range（D13）。Value = Sheets（DataSheet）。Cells（RngRow.Row，10）.Value 
 
表格（2）.Range（F13） .Value = Sheets（DataSheet）。Cells（RngRow.Row，11）.Value 
 
 Sheets（2）.Range（B16）。Value = Sheets（DataSheet）。 （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）。范围（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 
 
表格（2）.Range（D21）。Value = Sheets（DataSheet）。Cells（RngRow.Row，19）.Value 
 
表格（2）.Range（B23 ）.Value = Sheets（DataSheet）。Cells（RngRow.Row，20）.Value 
 
表格（2） .Range（D23）。Value = Sheets（DataSheet）。Cells（RngRow.Row，21）.Value 
 
'将某些字段的值连接到一个字段
表2）.Range（A26）。Value = Sheets（DataSheet）。Cells（RngRow.Row，23）.Value&细胞（RngRow.Row，24）.Value&细胞（RngRow.Row，24）.Value&细胞（RngRow.Row，25）.Value&细胞（RngRow.Row，26）.Value&细胞（RngRow.Row，27）.Value 
 
 
下一个RngRow 
 
 
 End Sub 
  / pre> 
 
 
目前，执行代码会导致第106行的1004运行时错误： Sheets（2）.Name =表格（DataSheet）。单元格（RngRow.Row，1）.Value 。 
 
 
 
我尽可能避免错误恢复代码块，因为我认为他们是最后的手段，但我有点死胡同，可以使用面向对象/一般VBA解决方案的帮助/建议。
 
 
 
 编辑 
 
 
 
 
 
 
要进一步说明，添加简单代码
  MsgBox（Sheets（2）.Name）
  
 after 
  Sheets（2）.Name = Sheets（DataSheet）。Cells（RngRow.Row，1）.Value 
  
返回A2的100-AAA测试值，Rng.Rows = 1。此外，测试表通过调用删除脚本使用此问题开发的代码执行开始时被删除。代码失败在Rng.Rows = 2。
解决方案
我想我已经找到你的答案... 
 
 
 
在您的代码中：
 带表格（Sheet1）
 
 LastCell = .Range（A& Sheets（Criteria）。Rows.Count）.End（xlUp）.Row 
设置RngTwo = .Range（A2：AA& LastCell ）
 
结束
 
'将数据推送到DataSheet工作表中，因此数据是顺序的
表单（1）。选择
 RngTwo.Copy 
表（DataSheet）。选择
 ActiveSheet.Paste 
  
您设置RngTwo = .Range（A2：AA& LastCell），这意味着粘贴到 DataSheet  。然后在这个块之下，这个块
 如果LastCell = 2然后
 
设置RngThree = .Range（ A2）
  
无法正常工作，因为您只复制了1行数据，因此 A2 为空。您可能没有注意到，因为没有错误，但这也意味着当标准大于1时，总是将列表中的第一个元素放在 DataSheet  
 
 
 
 
 
 
我看到有两种解决方案：更改 LastCell 检查以设置从第1行开始的范围：
 如果LastCell = 2然后
设置RngThree = .Range （A1）'更改此线
 Else 
 LastCell = .Range（A& Sheets（Criteria）。Rows.Count）.End（xlUp）.Row 
设置RngThree = .Range（A1：A& LastCell）'更改此行
如果
  
  OR 将您的副本范围设置为包含第一个标题行：
 带有（Sheet1）
 
 LastCell = .Range（A& Sheets（Criteria）。Rows.Count）.End（xlUp）.Row 
设置RngTwo = .Range （A1：AA& LastCell）'更改此行
 
结束
 
'将数据推送到DataSheet工作表单，所以数据是顺序的
表格（1）。选择
 RngTwo.Copy 
表格（DataSheet）。选择
 ActiveSheet.Paste 
  
 
 
 
 
 
 
为了记录，我测试了上述两个选项与一个和许多标准。所有似乎都适用于我。
 
 
 
我希望这有助于... 
 
I am continuing to expand on the functionality of sorting and organizing data pulled from a mainframe. This question is in regard to an expansion of functionality from this question's focus. The data is alphanumeric, and is similar to that found in this previously asked question.

I am attempting to permit users to use a list of 1 item in the criteria sheet of my dataset, as well as multiple items. My code is as follows:
'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
Currently, execution of the code results in a '1004' run-time error on line 106: Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value. 

I avoid On Error Resume code blocks as much as possible, as I consider them to be a last resort, but I am at a bit of a dead-end, and could use aid/advice for an object oriented / general VBA solution.

EDIT



For additional clarification, adding the simple code 
MsgBox (Sheets(2).Name)
after 
Sheets(2).Name = Sheets("DataSheet").Cells(RngRow.Row, 1).Value
returns the test value of "100-AAA" for "A2", at Rng.Rows = 1. Moreover, Test Sheets are removed at the beginning of the code execution by calling a delete script developed with this question. The code fails at Rng.Rows = 2.
解决方案
I think I've found your answer...

In your code:
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
You Set RngTwo = .Range("A2:AA" & LastCell), which means your header is not being included when pasted into DataSheet. Then below that, this block
If LastCell = 2 Then

    Set RngThree = .Range("A2")
Will not work, because you've only copied 1 row of data, thus A2 is blank. You may not have noticed, since there was no error, but this also means the case when the criteria are greater than 1 was always leaving out the first element in the list on DataSheet.



There are two solutions as I see it: Change the LastCell check to set the range starting at row 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
OR Set your copy range to include the first, header row:
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




For the record, I did test both the above options with both one and many criteria. All seemed to work just fine for me.

I hope this helps...

                        
这篇关于Loop在Range.Rows = 2  -  VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！