Excel宏查找列表中的行并替换另一个列表中的数据

oalqel3c 于 2023-06-25 发布在其他

关注(0)|答案(2)|浏览(134)

我想知道是否有一种方法在VBA中有一个宏检查SKU和存储从“SheetB”，如果发现在“SheetA”然后取代“STORE”，“PRODUCT_TYPE”和“CONCAT”列的信息从“SheetB”（蓝色）和循环通过表，如果新的被添加。

*示例：*所有Sku为：95908352和商店：-1\f25 SheetA-1中的信息将更改为-1\f25“SheetB”-1上的蓝色列。SheetA STORE将替换为SheetB Store（Autofill），SheetA PRODUCT_TYPE将替换为SheetB Product Type（Autofill），SheetA CONCAT将替换为SheetB Move to。

如果有更多的异常添加到SheetB表中，则循环遍历该列表。

SheetA（之前）：

SheetB：

表A（后）：

Dim wsD As Worksheet, wsE As Worksheet, r As Long
Dim rngData As Range, rngEx As Range, mH, mR, col As Long, hdr, v
Dim rngCopy As Range, lr As Long, addr

Set wsD = ThisWorkbook.Worksheets("Data")
Set wsE = ThisWorkbook.Worksheets("SKU Exceptions")

Set rngData = wsD.Range("A3:Z" & wsD.Cells(Rows.Count, "A").End(xlUp).Row)

For col = 1 To 3  'loop the columns on the exceptions sheet
    lr = wsE.Cells(Rows.Count, col).End(xlUp).Row
    If lr > 1 Then
    
    
    
    
        'get the values and find on "Data"
        hdr = Replace(wsE.Cells(1, col).Value, "Product Type (Move to) ", "")
        hdr2 = Replace(wsE.Cells(1, col).Value, "Store (Autofill) ", "")
        mH = Application.Match(hdr, rngData.Columns(17), 0) And Application.Match(hdr2, rngData.Columns(1), 0)

        If Not IsError(mH) Then 'matched both values?
            For r = 2 To lr
                v = wsE.Cells(r, col).Value
                mR = Application.Match(v, rngData.Columns(17), 0)
                If Not IsError(mR) Then
                    'Copy new values over
                    

                    
                Else
                    'value was not matched
                    MsgBox "Value '" & v & "' not found on Data sheet!"
                End If
            Next r
        Else
            'header not matched
            MsgBox "Header '" & hdr & "' not found on data sheet!"
        End If
    End If
Next col

MsgBox "Sku's have been reordered successfully!", vbInformation, "Reorder Sku's Macro"

excel

来源：https://stackoverflow.com/questions/76476370/excel-macro-find-rows-in-list-and-replace-data-from-another-list

2条答案

按热度按时间

kqqjbcuj1#

当匹配>1列时，使用脚本字典来创建组合键和相应行的Map通常更容易：

Sub Test()

    Dim wsD As Worksheet, wsE As Worksheet
    Dim rngData As Range, rngEx As Range, rwEx As Range
    Dim dict As Object, rwD As Range, rwE As Range, k
    
    Set dict = CreateObject("scripting.dictionary")
    
    Set wsD = ThisWorkbook.Worksheets("Data")
    Set rngData = wsD.Range("A3:Z" & wsD.Cells(Rows.Count, "A").End(xlUp).Row)
    
    Set wsE = ThisWorkbook.Worksheets("SKU Exceptions")
    Set rngEx = wsE.Range("A2:E" & wsE.Cells(Rows.Count, "A").End(xlUp).Row)
    
    'Map exception rows to composite key of `store~~SKU`,
    '   assuming combination is unique...
    For Each rwE In rngEx.Rows
        k = rwE.Cells(1).Value & "~~" & rwE.Cells(2).Value
        dict.Add k, rwE
    Next rwE
    
    'loop the data rows and check for matching exceptions
    For Each rwD In rngData.Rows
        k = rwD.Cells(1).Value & "~~" & rwD.Cells(3).Value 'composite key
        If dict.exists(k) Then
            Set rwEx = dict(k)
            rwD.Cells(1).Value = rwEx.Cells(4).Value
            rwD.Cells(2).Value = rwEx.Cells(5).Value
        End If
    Next rwD
    
    MsgBox "Sku's have been reordered successfully!", vbInformation, "Reorder Sku's Macro"

End Sub

赞(0）回复(0）举报 2023-06-25

yyyllmsg2#

如果我没理解错的话…

Sub test()
Dim wsD As Worksheet, wsE As Worksheet
Dim rgE As Range, cell As Range, rgStore As Range, rgR As Range

Set wsD = ThisWorkbook.Worksheets("Data")
Set wsE = ThisWorkbook.Worksheets("SKU Exceptions")
Set rgE = wsE.Range("B2", wsE.Range("B" & Rows.Count).End(xlDown))

For Each cell In rgE
    If Not wsD.Columns(3).Find(cell.Value) Is Nothing Then
        With wsD.Columns(3)
        .Replace cell.Value, True, xlWhole, , False, , False, False
        Set rgStore = .SpecialCells(xlConstants, xlLogical).Offset(0, -2)
        .Replace True, cell.Value, xlWhole, , False, , False, False
        End With

        If Not rgStore.Find(cell.Offset(0, -1).Value) Is Nothing Then
        
            With rgStore
            .Replace cell.Offset(0, -1).Value, True, xlWhole, , False, , False, False
            Set rgR = .SpecialCells(xlConstants, xlLogical)
            .Replace True, cell.Offset(0, -1).Value, xlWhole, , False, , False, False
            End With

            rgR.Value = cell.Offset(0, 2).Value
            rgR.Offset(0, 1).Value = cell.Offset(0, 3).Value
            rgR.Offset(0, 13).Value = cell.Offset(0, 1).Value
    
        End If
    End If
Next

End Sub

子创建rgE，它是从B2到行尾的wsE列SKU的范围。然后它循环到rgE内的每个细胞。
在循环期间，它检查是否在wsD列3中找到循环的单元格值，然后设置rgStore变量。因此，rgStore是wsD的列A中的范围，其中rgStore的单元格偏移（0，2）值是循环单元格值。
接下来，它检查是否在rgStore中找到循环的cell. offset（0，-1）值，然后它设置rgR变量。因此，rgR是wsD的列A中的范围，其中rgR的单元格值是循环单元格. offset（0，-1）.值，而单元格. offset（0，2）值是循环单元格值。
最后得到所需的结果。
未使用虚拟数据进行测试。

赞(0）回复(0）举报 2023-06-25

我来回答

Excel宏查找列表中的行并替换另一个列表中的数据

2条答案

相关问题

热门标签

最新问答