查找列范围内的所有匹配项并复制范围内的所有值

时间:2019-05-28 10:05:51

标签: excel vba

首次用户在这里。 我还是一个初学者,试图在VBA中为Excel 2010编写程序,这是我需要做的。

我有一个工作簿,其中包含两张工作表Sheet1,称为“流程” (具有标题为“ Item”的列A)和Sheet2称为“主”(具有标题为“ Item”的列A和具有标题为“ Operation”的列B)

我需要比较这两列A,如果有任何匹配的数据,我想从“主”表中复制B列“操作”中的所有数据,并将其放入“过程”表中的B列中。

Mohit Bansal先生的代码运行正常,但是在我尝试将代码置于工作表的真实状态后,我面临着一个新问题,即如果A列“项目”中有相同数据,则只能复制第一个数据。

任何帮助弄清楚如何克服这一困难的人,将不胜感激。

在此,我将根据工作表的实际情况进行编辑。

Sheet1“处理”

-------------------------
|Column A   |Column B   |
|"Item"     |"Operation"|
-------------------------
|20YStandard|           |
|20Y        |           |
|20Y        |           |
|20Y        |           |
|20YF0Blank |           |
|20YF0      |           |
|20YF0      |           |
|20YFGAfter |           |
|20YFG      |           |
|20YFG      |           |
|20YStandard|           |
|20Y        |           |
|20Y        |           |
|20Y        |           |
|20YF0Blank |           |
|20YF0      |           |
|20YF0      |           |
|20YFGAfter |           |
|20YFG      |           |
|20YFG      |           |

Sheet2“大师”

-------------------------
|Column A   |Column B   |
|"Item"     |"Operation"|
-------------------------
|20Y        |MLM1       |
|20Y        |IQTM1      |
|20Y        |HBM1       |
|20YF0      |QT1        |
|20YF0      |SB1        |
|20YFG      |FG7        |
|20YFG      |SCR1       |
|21YF0      |QT2        |
|21YF0      |SB2        |
|21YF0      |MG2        |
|21YFG      |FG8        |
|21YFG      |SCR2       |

实际结果=

Sheet1“处理”

-------------------------
|Column A   |Column B   |
|"Item"     |"Operation"|
-------------------------
|20YStandard|           |
|20Y        |MLM1       |
|20Y        |IQTM1      |
|20Y        |HBM1       |
|20YF0Blank |           |
|20YF0      |QT1        |
|20YF0      |SB1        |
|20YFGAfter |           |
|20YFG      |FG7        |
|20YFG      |SCR1       |
|20YStandard|           |
|20Y        |Not copied |
|20Y        |Not copied |
|20Y        |Not copied |
|20YF0Blank |           |
|20YF0      |Not copied |
|20YF0      |Not copied |
|20YFGAfter |           |
|20YFG      |Not copied |
|20YFG      |Not copied |

Sub Button2_Click()

pr = Worksheets("Process").Range("A2:B1000").Value

ma = Worksheets("Master").Range("A2:B8008").Value

Range("B:B").ClearContents

For i = LBound(pr, 1) To UBound(pr, 1)

    For j = LBound(ma, 1) To UBound(ma, 1)

        If ma(j, 1) = pr(i, 1) Then

            Worksheets("Process").Range("B" & i + 1).Value = ma(j, 2)
            ma(j, 1) = "---"

            Exit For

        End If
Next j
Next i
End Sub

预期结果=

Sheet1“处理”

-------------------------
|Column A   |Column B   |
|"Item"     |"Operation"|
-------------------------
|20YStandard|           |
|20Y        |MLM1       |
|20Y        |IQTM1      |
|20Y        |HBM1       |
|20YF0Blank |           |
|20YF0      |QT1        |
|20YF0      |SB1        |
|20YFGAfter |           |
|20YFG      |FG7        |
|20YFG      |SCR1       |
|20YStandard|           |
|20Y        |MLM1       |
|20Y        |IQTM1      |
|20Y        |HBM1       |
|20YF0Blank |           |
|20YF0      |QT1        |
|20YF0      |SB1        |
|20YFGAfter |           |
|20YFG      |FG7        |
|20YFG      |SCR1       |

2 个答案:

答案 0 :(得分:0)

您可以使用Find FindNext

Sub Button2_Click()
    Dim firstAddress As String
    Dim finalrow As Long, i As Long
    Dim shtCS As Worksheet, shtFD As Worksheet, rw As Range
    Dim c

    Set shtCS = Worksheets("Process")
    Set shtFD = Worksheets("Master")

    finalrow = shtFD.Range("A" & Rows.Count).End(xlUp).Row

    With shtFD.Columns(1)
        For i = 2 To finalrow
            Set c = .Find(shtCS.Cells(i, 1).Value2)

            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    shtCS.Cells(i, 2).Value2 = c.Offset(0, 1).Value2
                    i = i + 1
                    Set c = .FindNext(c)
                Loop Until c.Address = firstAddress
            End If
        Next i
    End With
End Sub

答案 1 :(得分:0)

这很正常:

pr = Worksheets("Process").Range("A2:B11").Value
ma = Worksheets("Master").Range("A2:B13").Value


For i = LBound(pr, 1) To UBound(pr, 1)

    For j = LBound(ma, 1) To UBound(ma, 1)

        If ma(j, 1) = pr(i, 1) Then

            Worksheets("Process").Range("B" & i + 1).Value = ma(j, 2)
            ma(j, 1) = "---"
            Exit For

        End If
Next j
Next i

Output

新答案

仅在过程表中有10行重复出现

子Button2_Click()

pr = Worksheets("Process").Range("A2:B21").Value

ma = Worksheets("Master").Range("A2:B13").Value

Worksheets("Process").Range("B:B").ClearContents

For i = LBound(pr, 1) To UBound(pr, 1)

    If i = 11 Then ma = Worksheets("Master").Range("A2:B13").Value

    For j = LBound(ma, 1) To UBound(ma, 1)

        If ma(j, 1) = pr(i, 1) Then

            Worksheets("Process").Range("B" & i + 1).Value = ma(j, 2)
            ma(j, 1) = "---"

            Exit For

        End If
Next j
Next i
End Sub