メインフレームから取得したデータを整理およびシフトするために、マクロ構築の取り組みを拡張しています。データは、ここで説明したものと同様の文字列形式です。また、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 行目で型の不一致が発生します: 84Sheets(2).Name = Sheets("DataSheet").Cells(RngRow, 1).Value行目がコメントアウトされている場合は、その後の行で型の不一致が発生します。コードを効果的に機能させるには、これをどのように修正すればよいかわかりません。この特定の問題の修正を求めています。
より一般的な関心事は私のアプローチです。また、このマクロについて考慮すべき提案、アドバイス、アプローチ、または改善を歓迎します。ただし、最適化の取り組みを行う前に、修正が最も重要です。