「bom」、「MPS」、「DData」の 3 つのシートがあります。私がやろうとしているのは、まず「MPS」からセル A2 の値を読み取り、その値を持つ列 A のすべての行を「bom」から取得して、「DData」にリストすることです。
同時に、「MPS」の列 C と D の値を対応する行に取得する必要があります。したがって、「MPS」のセル A2 の値が「bom」の 4 行と一致する場合、セル C2 と D2 の値はそれらの 4 行の後に配置される必要があります。現時点では、これは適切に機能しません。
このループが完了すると、「MPS」のセル値 A3 に移動するなど、次のようになります。以下のコードは、ある程度機能します。2 つ目の for ループを追加したり、思いついた他のすべてのことを試してみましたが、うまくいきませんでした。最大の問題は、MPS!A2値が 1、A3= 2 で、A4再び 1 の場合、「bom」の値が 2 回目にリストされないことです。
コードは元々これに基づいています:https://stackoverflow.com/a/26912176
Public Sub CommandButton1_Click()
Dim countRows1 As Long, countRows2 As Long
countRows1 = 2 'the first row of your dataset in sheet1
endRows1 = 50 'the last row of your dataset in sheet1
countRows2 = 2 'the first row where you want to start writing the found rows
For j = countRows1 To endRows1
Dim keyword As String: keyword = Sheets("MPS").Cells("A2, A100").Value
If Sheets("bom").Range("A2, A100").Value = keyword Then
Sheets("DData").Rows(countRows2).Value = Sheets("bom").Rows(j).Value
Sheets("DData").Rows(countRows2).Cells(6).Value = Sheets("MPS").Rows(countRows2).Cells(3).Value
Sheets("DData").Rows(countRows2).Cells(7).Value = Sheets("MPS").Rows(countRows2).Cells(4).Value
countRows2 = countRows2 + 1
End If
Next j
End Sub
これには間違いなく 2 つのループが必要だと私は思っていますが、うまく動作しませんでした。
画像を投稿することはできませんが、以下で何が必要で何が起こっているのかをよりわかりやすく説明してみたいと思います。
シート「bom」の構造とデータ (範囲 A1:E7):
id desc id_part desc_part qty
30010 build1 10200 part1 1
30010 build1 23002 part2 3
30010 build1 21003 part3 500
30010 build1 21503 part4 400
20010 build2 10210 part5 100
20010 build2 10001 part6 5
シート「MPS」の構造とデータ (範囲 A1:D4):
id desc week batches
30010 build1 1 2
20010 build2 2 4
30010 build1 2 0
シート「DData」構造 (範囲 A1:H3) と、コード パンハンドルで返される内容:
id desc id_part desc_part qty week batches total(=qty*batches)
30010 1 2
30010 2 0
私の目標は次のとおりです。
id desc id_part desc_part qty week batches total (=qty*batches)
30010 build1 10200 part1 1 1 2
30010 build1 23002 part2 3 1 2
30010 build1 21003 part3 500 1 2
30010 build1 21503 part4 400 1 2
20010 build2 10210 part5 100 2 4
20010 build2 10001 part6 5 2 4
30010 build1 10200 part1 1 2 0
30010 build1 23002 part2 3 2 0
30010 build1 21003 part3 500 2 0
30010 build1 21503 part4 400 2 0
...また、たとえば H2 の値は E2 * G2 になります。
*** 変更しようとしました
Sheets("DData").Range("A" & countRows2).Value = Sheets("bom").Range("A" & lCount).Value
に
Sheets("DData").Rows(countRows2).Value = Sheets("bom").Rows(lCount).Value
たとえば、Excel がクラッシュし始めました。行ではなく範囲を使用する方が賢明でしょうか?
答え1
編集済み: 1 つのループは MPS 列 A を 1 行ずつ処理し、2 番目のループは各 MPS 列 A の値をすべての "bom" 列 A の値と比較します。一致が見つかると、各セルが DData シートにコピーされ (もっと高速な方法があると思いますが、この方法で何が起こっているかがよくわかります)、列 H に合計を計算する数式が設定されます。
タブは現在のものと同じように設定されており、期待どおり/必要なものが得られます。
Sub Button1_Click()
Dim countRows2 As Long
countRows2 = 2 'the first row where you want to start writing the found rows
Dim szMPSValues As Variant
Dim szbomValues As Variant
Dim lCount As Long
Dim lCountbom As Long
Dim MPSRng As Range
Dim bomRng As Range
Dim szConcatString As Variant
Dim strKeyword As String
'gets range of used cells
Set MPSRng = Intersect(Columns("A").Cells, Worksheets("MPS").UsedRange)
If MPSRng Is Nothing Then MsgBox "Nothing to do"
'have to switch sheets to set the second loop's range of "bom" values
Worksheets("bom").Activate
Set bomRng = Intersect(Columns("A").Cells, Worksheets("bom").UsedRange)
Worksheets("MPS").Activate
'saves range values into arrays
szMPSValues = MPSRng.Value
szbomValues = bomRng.Value
'double check a to be sure its an array and of proper size
If Not IsArray(szMPSValues) Then ReDim a(1, 1): szMPSValues = MPSRng.Value
'loop through array concatenating cell values with a space after cell value
'NOTE: Changed this to start at 2 in case you have a header row**
For lCount = 2 To UBound(szMPSValues)
strKeyword = Sheets("MPS").Range("A" & lCount).Value 'gets MPS.A2, MPS.A3, etc
For lCountbom = 2 To UBound(szbomValues)
If Sheets("bom").Range("A" & lCountbom).Value = strKeyword Then 'compares to bom.A2, bom.A3, etc
Sheets("DData").Range("A" & countRows2).Value = Sheets("bom").Range("A" & lCountbom).Value
Sheets("DData").Range("B" & countRows2).Value = Sheets("bom").Range("B" & lCountbom).Value
Sheets("DData").Range("C" & countRows2).Value = Sheets("bom").Range("C" & lCountbom).Value
Sheets("DData").Range("D" & countRows2).Value = Sheets("bom").Range("D" & lCountbom).Value
Sheets("DData").Range("E" & countRows2).Value = Sheets("bom").Range("E" & lCountbom).Value
Sheets("DData").Range("F" & countRows2).Value = Sheets("MPS").Range("C" & lCount).Value
Sheets("DData").Range("G" & countRows2).Value = Sheets("MPS").Range("D" & lCount).Value
Sheets("DData").Range("H" & countRows2).Formula = "=$F" & countRows2 & "*$G" & countRows2
countRows2 = countRows2 + 1
End If
Next lCountbom
Next lCount
End Sub