2012-08-10 52 views
1

我伸出我的微距建設工作,組織和轉變,從大型機檢索到的數據生成的模板工作表。數據採用字符串形式,類似於here。我也在利用用SO建議開發的宏和這些問題的幫助(1)(2)。從數據表數據推入

我花了很多時間制定宏觀的這個特定部分,在其他部分工作的同時點由於我在發展中遇到的困難 - 或許是由於缺乏經驗。

說得簡潔地說,我生成的工作表,重命名它們和推入的數據的工作表的那些,其被生成,然後填充空白表單。我試圖在行的基礎上做到這一點,因爲每一行本質上是一個我正在推向工作表格的記錄。有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註釋。我不確定我應該如何糾正這一點,以使我的代碼有效運行,並且我正在要求解決這個特定問題。

更普遍關心的是我的方法,我會請也歡迎任何建議,意見,辦法或改進,以考慮該宏 - 雖然修復是派諾蒙重要性之前,我進行任何形式的優化工作。

回答

3

在使用造成的錯誤RngRow.Row代替RngRow線。

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 
+0

丹尼爾,你的解決方案工作得很好。至於縮短代碼,我會盡量避免「選擇」和不必要的冗長程序。 – JackOrangeLantern 2012-08-10 16:43:39