excel - 将数据从一个 AWS 复制到另一个 AWS，并根据第一个工作表添加 3 个新列

Question

我有两张工作表:一张名为 (raw_data)，另一张名为 (stock_check)。该文件在名为 raw_data 的工作表中有大约 200k~ 行。
raw_data 如下所示(仅添加了对这种情况重要的列)。

在我的第一张工作表 raw_data 上，我大约有 50 多列，其中我试图根据标题 ID 将两列复制到工作表 stock_check 并删除重复项。为此，我使用以下代码:

Sub CopyMultipleColumns()

Dim wb As Workbook
Dim newSht As Worksheet, Hdrs As Variant, i As Long, EdrisRange As Range

Hdrs = Array("Sales_ID", "Category", "ShopTo_ID")

Set wb = ThisWorkbook

Set newSht = ThisWorkbook.Worksheets("stock_check")

For i = LBound(Hdrs) To UBound(Hdrs)
    Set EdrisRange = FindHeaderInWorkbook(wb, CStr(Hdrs(i)), newSht)
    If Not EdrisRange Is Nothing Then
        Application.Intersect(EdrisRange.EntireColumn, EdrisRange.Parent.UsedRange).Copy _
                                                     newSht.Cells(1, i + 1).PasteSpecial xlPasteValues
    End If
Next i

Application.CutCopyMode = False

End Sub

调用以下函数查找工作表 raw_data 中的特定标题

Function FindHeaderInWorkbook(wb As Workbook, HeaderText As String, excludeSheet As 
Worksheet)
Dim sht As Worksheet, rng As Range
For Each sht In wb.Worksheets
    If sht.Name <> excludeSheet.Name Then
        Set rng = sht.Rows(1).Find(what:=HeaderText, lookat:=xlWhole)
        If Not rng Is Nothing Then Exit For
    End If
Next sht
Set FindHeaderInWorkbook = rng
End Function

然后，我将使用以下 VBA 中的 RemoveDuplicates 函数删除其中的重复项。

Sub RemoveDuplicates()

With ThisWorkbook.Worksheets("stock_check")
   .UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
End With

End Sub

到目前为止，一切正常，它在 Excel 中生成以下输出(Excel 中的一个唯一行):

这是我被卡住/不知道如何继续的部分。我接下来要做的是创建一个 available_size 列(在 ShopTo_ID 旁边)，它将 raw_data 中该特定 sales_ID 的所有可用尺寸加在一起，并用“，”分隔它们。请参阅下面的我的预期结果:

下一步，我想检查 core_size 是否可用，为此我有以下规则集:

如果 available_size 包括尺寸 8 和 9，则为“YES”，否则为“NO”

这应该生成以下输出:

作为最后一步，我想添加一个名为 stock_depth 的列，基于 ","的数量，如果基于规则集有足够的库存深度，它将检查类别 X/Y:

如果 available_size 等于或大于 4 且类别为 X，则为"is"，否则为“否”

如果 available_size 等于或大于 2 且类别为 Y，则为"is"，否则为“否”

这应该生成以下内容:

谁能给我一些关于如何继续的指示？非常感谢!

Answer 1

唯一 ID 的字典，大小的集合。

Option Explicit

Sub StockCheck()

    Const SEP = "~"

    Dim wb As Workbook, ws As Worksheet, wsData As Worksheet
    Dim a, Hdrs, HCol, data
    Dim hasChkSht As Boolean, hasData As Boolean
    Dim lastrow As Long, i As Long, x As Long
    Dim t0 As Single: t0 = Timer
   
    Hdrs = Array("Sales_ID", "Category", "ShopTo_ID", "SizeDescription")
    ReDim data(UBound(Hdrs)) As Variant
   
    ' find data sheets
    Set wb = ThisWorkbook
    For Each ws In wb.Sheets
        If ws.Name = "stock_check" Then
            hasChkSht = True
         Else
            a = Application.Match(Hdrs(0), ws.Rows(1), 0)
            If Not IsError(a) Then
                hasData = True
                Set wsData = ws
                Exit For
            End If
        End If
    Next
    
    If hasData = False Then
        MsgBox "Could not locate Header " & Hdrs(0), vbCritical
        Exit Sub
    End If
    
    ' copy data into arrays
    Dim ar
    With wsData
        lastrow = .Cells(.Rows.Count, a).End(xlUp).Row
    
        ' find columns
        For i = 0 To UBound(Hdrs)
            a = Application.Match(Hdrs(i), wsData.Rows(1), 0)
            If IsError(a) Then
                MsgBox "Could not locate Header " & Hdrs(i), vbCritical
                Exit Sub
            Else
                ar = data(i)
                ReDim ar(1 To lastrow - 1, 1 To 1)
                data(i) = wsData.Cells(2, a).Resize(lastrow - 1).Value2
            End If
        Next
    End With
    
    ' collate data
    Dim dict As Object, k, hasSize As Boolean
    Dim s As String, sz As String, n As Long
    Set dict = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(data(0))
        k = data(0)(i, 1) & SEP & data(1)(i, 1) & SEP & data(2)(i, 1)
        sz = data(3)(i, 1)
        'Debug.Print "Row", i, k, sz
        
        If Not dict.exists(k) Then
            dict.Add k, New Collection
            dict(k).Add sz
            'Debug.Print k, dict(k)(1)
        Else
            ' check size collection
            hasSize = False
            For n = 1 To dict(k).Count
                'Debug.Print n, dict(k)(n), sz
                If dict(k)(n) = sz Then
                    hasSize = True
                    Exit For
                End If
            Next
            ' add if required
            If hasSize = False Then
                dict(k).Add sz
                'Debug.Print k, sz
            End If
        End If
    Next
    
    ' output
    i = 2
    Application.ScreenUpdating = False
    With wb.Sheets("stock_check")
        .Cells.Clear
        .Range("A1:F1") = Array("Sales_ID", "Category", "ShopTo_ID", "sizes_available", _
                          "core size?", "stock_depth")
        For Each k In dict
        
            ar = Split(k, SEP)
            .Cells(i, 1) = ar(0)
            .Cells(i, 2) = ar(1)
            .Cells(i, 3) = ar(2)
            .Cells(i, 5) = "NO"
            
            ' sizes
            s = ""
            For n = 1 To dict(k).Count
                sz = dict(k).Item(n)
                If n > 1 Then s = s & ","
                s = s & sz
                ' core ?
                If sz = 8 Or sz = 9 Then
                    .Cells(i, 5) = "YES"
                End If
            Next
            .Cells(i, 4) = s
            
            ' stock
            If ar(1) = "X" And dict(k).Count >= 4 Then
                s = "YES"
            ElseIf ar(1) = "Y" And dict(k).Count >= 2 Then
                s = "YES"
            Else
                s = "NO"
            End If
            .Cells(i, 6) = s
            
            i = i + 1
        Next
        .Activate
        .Range("A1").Select
    End With
    Application.ScreenUpdating = True
    MsgBox lastrow - 1 & " rows processed", vbInformation, Format(Timer - t0, "0.0 secs")

End Sub