☰

Excel VBA 行获取循环

tag-icon • tag-icon microsoft-excel vba
Excel VBA 行获取循环

我有三张表：“bom”、“MPS”和“DData”。我要做的是首先从“MPS”读取单元格 A2 的值，然后从“bom”中获取 A 列中具有该值的所有行，并将它们列到“DData”。

同时，我需要将“MPS”中 C 列和 D 列的值提取到相应的行。因此，如果“MPS”单元格 A2 值中的值与“bom”中的 4 行匹配，则单元格 C2 和 D2 中的值应放在这 4 行之后。目前这还不能正常工作。

一旦完成此循环，它应该转到“MPS”中的单元格值 A3，依此类推...下面的代码有点用。我尝试添加第二个 for 循环和想到的所有其他方法，但都没有成功。最大的问题是，如果MPS!A2值为 1，A3= 2 并且A4再次为 1，它不会再次列出“bom”中的值。

该代码最初基于此：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

我心里想着这肯定需要两个循环，但我就是无法让它工作。

我无法发布图片，但我会尝试在下面更好地说明需要做什么以及发生什么。

工作表“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）以及代码 panhandel 返回的内容：

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 开始严重崩溃。使用 Range 而不是 Rows 是否更明智？

答案1

编辑：一个循环逐行遍历 MPS 列 A，第二个循环将每个 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

相关内容