将数据从表中推送到生成的模板工作表中

时间:2012-08-10 15:06:52

标签: vba excel-vba excel

我正在扩展我的宏建设工作,以组织和转移从大型机检索到的数据。数据采用字符串形式,类似于here所述。我也在利用这些问题(1)(2)的SO建议和帮助开发的宏。

由于我在开发过程中遇到的困难 - 可能是由于经验不足,我花了很多时间来开发宏的这个特定部分,同时处理其他部分。

简而言之,我正在生成工作表,重命名它们并将数据推送到那些生成的工作表中,然后用空白表单填充。我试图在行的基础上这样做,因为每行基本上是一个我正在推送到工作表表单的记录。我正在使用20个字段并推送到每个新工作表。

我最初尝试了一个高度嵌套的循环,然后考虑了如何使用结构。然而,随着我越来越困惑,我转而使用离散模型,因为我注意到我仍然没有想出如何正确使用Range对象的Cells(单元格地址属性)。

代码如下:

'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 DataShifter()


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 Crtieria Sheet
With Sheets("Criteria")
    LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).row
    Set RngOne = .Range("A2:A" & LastCell)
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")

'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")
LastCell = .Range("A" & Sheets("Criteria").Rows.Count).End(xlUp).row
Set RngThree = .Range("A2:A" & LastCell)

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("TemplateSheet2").Select
Cells.Select
Selection.Copy
Sheets(2).Select
ActiveSheet.Paste

Sheets(2).Name = Sheets("DataSheet").Cells(RngRow, 1).Value

Sheets(2).Range("B3") = Sheets("DataSheet").Cells(RngRow, 1).Value
Sheets(2).Range("D3") = Sheets("DataSheet").Cells(RngRow, 2).Value
Sheets(2).Range("F3") = Sheets("DataSheet").Cells(RngRow, 3).Value
Sheets(2).Range("B5") = Sheets("DataSheet").Cells(RngRow, 4).Value
Sheets(2).Range("B10") = Sheets("DataSheet").Cells(RngRow, 5).Value
Sheets(2).Range("B7") = Sheets("DataSheet").Cells(RngRow, 6).Value
Sheets(2).Range("D10") = Sheets("DataSheet").Cells(RngRow, 7).Value
Sheets(2).Range("F10") = Sheets("DataSheet").Cells(RngRow, 8).Value
Sheets(2).Range("B13") = Sheets("DataSheet").Cells(RngRow, 9).Value
Sheets(2).Range("D13") = Sheets("DataSheet").Cells(RngRow, 10).Value
Sheets(2).Range("F13") = Sheets("DataSheet").Cells(RngRow, 11).Value
Sheets(2).Range("B16") = Sheets("DataSheet").Cells(RngRow, 12).Value
Sheets(2).Range("D16") = Sheets("DataSheet").Cells(RngRow, 13).Value
Sheets(2).Range("F16") = Sheets("DataSheet").Cells(RngRow, 14).Value
Sheets(2).Range("B19") = Sheets("DataSheet").Cells(RngRow, 15).Value
Sheets(2).Range("D19") = Sheets("DataSheet").Cells(RngRow, 16).Value
Sheets(2).Range("F19") = Sheets("DataSheet").Cells(RngRow, 17).Value
Sheets(2).Range("B21") = Sheets("DataSheet").Cells(RngRow, 18).Value
Sheets(2).Range("D21") = Sheets("DataSheet").Cells(RngRow, 19).Value
Sheets(2).Range("B23") = Sheets("DataSheet").Cells(RngRow, 20).Value
Sheets(2).Range("D23") = Sheets("DataSheet").Cells(RngRow, 21).Value

 'Concatenate values from certain fields into one field
Sheets(2).Range("B26") = Sheets("DataSheet").Cells(RngRow, 23).Value & Cells(RngRow, 24).Value & Cells(RngRow, 24).Value & Cells(RngRow, 25).Value & Cells(RngRow, 26).Value & Cells(RngRow, 27).Value


Next RngRow


End Sub

目前,执行此代码会导致类型不匹配,首先是第84行:Sheets(2).Name = Sheets("DataSheet").Cells(RngRow, 1).Value,然后是前一行,如果第84行被注释掉的话。我不确定如何纠正这个问题以使我的代码有效运行,我要求解决这个特定问题。

更普遍的关注是我的方法,我也欢迎任何建议,建议,方法或改进,以考虑这个宏 - 虽然在我做任何优化努力之前修复是至关重要的。

1 个答案:

答案 0 :(得分:3)

导致错误的行而不是RngRow使用RngRow.Row

RngRowRangeRngRow.Row将返回RngRow第一行的数字。

Cells需要RowIndex(一个数字)和一个ColumnIndex。当您提供Range(而不是数字)和ColumnIndex时,它会抛出您指示的类型匹配错误。

以下是一个如何缩短/改进代码的示例,而不是:

Sheets.Add After:=Sheets(1)  
'Grab the text form from the Template and push it into the new sheet. 
Sheets("TemplateSheet2").Select 
Cells.Select 
Selection.Copy 
Sheets(2).Select 
ActiveSheet.Paste

虽然我会尽量避免使用select,但您应该可以使用相同的结果:

'Copy the Template into a new sheet.
Sheets("TemplateSheet2").Copy After:=Sheets(1)
Sheets(2).select