現在のマクロは、ブックまたはワークシートAから行ごとにデータを取り込み、一致するヘッダーに基づいて別のシートに分割します。私はそれをさらに進めて、これらのシートの間で文字列フィールドを分割することに問題があります。VBA、unqiue文字列によるワークシートのデータの並べ替え
たとえば、ブックA、B列のデータには10個の一意の文字列が含まれています。文字列xを1つのシートにのみ並べ替えることができます。シートxを含む行は特定のシートに移動し、文字列abcは通常どおりに動作します。
は、ここでは、動的ではないので、特に、ブックとシートの名前を呼んで、これまでの私のコードです:Option Explicit
Sub main()
Dim dsRng As Range
Dim sht As Worksheet
Dim AShtColsList As String, BShtColsList As String
Set dsRng = Workbooks("Workbook A").Worksheets("Sample Extract").Range("A1").CurrentRegion '<--| set your entire data set range in workbook "A" worksheet "ShtA" (change "A" and "ShtA" to your actual names)
dsRng.Sort key1:=dsRng.Range("A1"), order1:=xlAscending, Header:=xlYes '<--| sort data set range on its 1st column (which is "A", beginning it from column "A")
With Workbooks("Workbook B") '<--| refer "B" workbook
For Each sht In .Worksheets(Array("Stack", "Documentation", "Users")) '<--| loop through its worksheets
GetCorrespondingColumns dsRng, sht, AShtColsList, BShtColsList '<--| build lists of corresponding columns indexes in both workbooks
CopyColumns dsRng, sht, AShtColsList, BShtColsList '<--| copy listed columns between workbooks
Next sht
End With
End Sub
Sub GetCorrespondingColumns(dsRng As Range, sht As Worksheet, AShtColsList As String, BShtColsList As String)
Dim f As Range, c As Range
Dim iElem As Long
AShtColsList = "" '<--| initialize workbook "A" columns indexes list
BShtColsList = "" '<--| initialize workbook "B" current sheet columns indexes list
For Each c In sht.Rows(2).SpecialCells(xlCellTypeConstants, xlTextValues) '<--| loop through workbook "B" current sheet headers in row 2 *******
Set f = dsRng.Rows(1).Find(what:=c.Value, lookat:=xlWhole, LookIn:=xlValues) '<--| look up data set headers row for workbook "B" current sheet current column header
If Not f Is Nothing Then '<--| if it's been found ...
BShtColsList = BShtColsList & c.Column & "," '<--| ...update workbook "B" current sheet columns list with current header column index
AShtColsList = AShtColsList & f.Column & "," '<--| ...update workbook "A" columns list with corresponding found header column index
End If
Next c
End Sub
Sub CopyColumns(dsRng As Range, sht As Worksheet, AShtColsList As String, BShtColsList As String)
Dim iElem As Long
Dim AShtColsArr As Variant, BShtColsArr As Variant
If AShtColsList <> "" Then '<--| if any workbook "B" current sheet header has been found in workbook "A" data set headers
BShtColsArr = Split(Left(BShtColsList, Len(BShtColsList) - 1), ",") '<--| build an array out of workbook "B" current sheet columns indexes list
AShtColsArr = Split(Left(AShtColsList, Len(AShtColsList) - 1), ",") '<--| build an array out of workbook "A" corresponding columns indexes list
For iElem = 0 To UBound(AShtColsArr) '<--| loop through workbook "A" columns indexes array (you could have used workbook "A" corresponding columns indexes list as well)
Intersect(dsRng, dsRng.Columns(CLng(AShtColsArr(iElem)))).Copy sht.Cells(2, CLng(BShtColsArr(iElem))) '<--| copy data set current column into workbook "B" current sheet corresponding column starting from row 2 *******
Next iElem
End If
End Sub
感謝。
EDIT
コンプリートエキス。このサンプル抽出をブックBで呼び出します。
'ユーザーのシート。私のマクロはすでにこれを行います。
'ドキュメント' シートは、私のマクロは既にこのあまりに
'スタック' シートを行います。私のマクロはこれをしません。レコードのスタックオーバーフローとその関連する列をフィルタリングしました。
うまくいけば、このことができます。
@Ralph、いくつかのサンプルスクリーンショットを掲載しています。 – Jonnyboi
今すぐ写真で更新してください。うまくいけば、これは物事をより明確にするかもしれません。 – Jonnyboi