...そしてそれに直面しましょう、あなたはほとんど何を示していません。試したが期待どおりに動作しないコードをいくつか提示する必要があることも事実です。私は前の質問から、ネット上で見つけたコードを投稿し、人々にあなたのためにそれを調整するよう依頼したことに気付きました。だから、このサイトのほとんどの回答者は、あなたが単に他の人のコードを持ち上げてSOを修正したり、実際にVBAを勉強したいと思っているだけなのか、これについて疑問に思うだろうか？
私は後者（あなたの将来の質問がいくつかの「第一原理」のコーディングを示すことを望んでいる）と仮定し、この質問の解決策とともにあなたを助けます。それはかなり簡単なプロジェクトですが、そこにいくつかの面倒な側面があり、どこから始めたらいいか分かりません。
あなたは基本的に2つのタスクがあります。
- コードの最大数を探す
- 、あなたはあなたの基準に基づいているどのように多くのユニークな行の検索を。
最初のタスクは、単に各行をループして、各詳細の組み合わせが新しいものかどうかを確認する場合です。これを行う方法はたくさんあります。下のコードでは、詳細の組み合わせをキーとしてCollectionを使用しています。
2番目のタスクでは、すべてのコードをそれぞれの製品に追加し、最大のコード数を記録します。サンプルコードでは、第2のCollectionを使用しました。
これを処理する他の多くの方法があります（たとえばギザギザの配列で）、たとえば各製品の詳細が一意でない場合は、少し独創的にする必要があります。
データを適切に分割したら、出力配列の各行にアイテムを入力し、シートに配列を書き込むことになります。下のコードでは、元のデータを失わないように、Sheet2に書きました。
だから、ここで私はあなたが始めることを願っていますコードです。あなた自身で作業して理解してください...つまり、この記事に「ああ、そういう線が効いていない」という行に沿ってコメントを追加しないようにしてください。
Dim data As Variant
Dim products As Collection, details As Collection, codes As Collection
Dim detailsKey As String
Dim code As Variant, output() As Variant
Dim maxCodeSize As Long
Dim r As Long, c As Long
'Read data into array
With Sheet1 '~~> adjust this to your data sheet
data = .Range(.Cells(2, 1), .Cells(.Rows.Count, 5).End(xlUp)).Value2
End With
'Loop through rows to create unqiue product entries
Set products = New Collection
For r = 1 To UBound(data, 1)
'Create the keys
detailsKey = CStr(data(r, 1)) & "|" & _
CStr(data(r, 2)) & "|" & _
CStr(data(r, 4)) & "|" & _
CStr(data(r, 5))
'Test if product exists
Set details = Nothing
On Error Resume Next
Set details = products(detailsKey)
On Error GoTo 0
'If it doesn't exist add a new product to collection
If details Is Nothing Then
Set details = New Collection
With details
.Add data(r, 1), "NUMBER"
.Add data(r, 2), "TYPE"
.Add data(r, 4), "PROD"
.Add data(r, 5), "G/NG"
.Add New Collection, "CODES"
End With
products.Add details, detailsKey
End If
'Add the codes, keeping a note of max code count
Set codes = details("CODES")
codes.Add data(r, 3)
If maxCodeSize < codes.Count Then
maxCodeSize = codes.Count
End If
Next
'Size the output array
ReDim output(1 To details.Count + 1, 1 To 4 + maxCodeSize)
'Fill header row
output(1, 1) = "Number"
output(1, 2) = "Type"
For c = 1 To maxCodeSize
output(1, 2 + c) = "Code" & c
Next
output(1, 3 + maxCodeSize) = "Prod"
output(1, 4 + maxCodeSize) = "G/NG"
'Fill data rows
r = 2
For Each details In products
output(r, 1) = details("NUMBER")
output(r, 2) = details("TYPE")
c = 1
Set codes = details("CODES")
For Each code In codes
output(r, 2 + c) = code
c = c + 1
Next
output(r, 3 + maxCodeSize) = details("PROD")
output(r, 4 + maxCodeSize) = details("G/NG")
r = r + 1
Next
'Write output to Sheet2
Sheet2.Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output
G/NGが一致しないので、41mmはまだ2行になりますか？ –
それは配列の数式で行うことができます、VBAの必要はない、列または単一のセルですか？ –
私は、私が試したことで何かを得ることができませんでした。私は試合式をやってみましたが、それはうまくいかず、VBAのやり方を考えることができませんでしたので、私はここにいます。私はVBAを1つの列に入れましたが、 3列。 – DWS