Question

我是VBA的初学者，不知道如何编写这段代码，尽管花费数周时间。

我有一个如下所示的数据集：

order_id |的 ORDER_STATUS

12345 |完整

12345 |取消

67890 |完整

13579 |未决

13579 |完整

24680 |取消

24680 |完整

如上所示，我有一个不同状态数量的订单ID列表，有些只有1＆＃34;已完成＆＃34;和其他人一起完成＆＃34;，＆＃34;取消＆＃34;，＆＃34;待定＆＃34;我需要编写一个代码来查看每组订单ID并确定其验证状态。

在顺序或优先级中，如果order_id集包含至少1＆＃34; pending＆＃34;，则validated_status将为＆＃34; pending＆＃34;。如果没有＆＃34;待定＆＃34; status和order_id集至少包含1＆＃34;已取消＆＃34;，validated_status将被＆＃34;拒绝＆＃34;，并且仅当order_id集的所有order_status包含＆＃34;已完成＆＃34;将验证状态设置为＆＃34;已批准＆＃34;。在上面的示例中，以下验证状态为：

order_id |的 validated_status

12345 |拒绝

67890 |批准

13579 |未决

24680 |拒绝

这是我目前已编制的当前代码，但是每次运行此代码时excel都会崩溃（我是否意外地进入了无限循环？）。

Sub newtest()

Dim i, j, k as integer
Dim LastRow as Long
Dim firstid, validated_status_range, order_id_set as range

With worksheets("To update")

    LastRow = .Range("A" & .Rows.Count).end(xlUp).Row

    'Remove duplicate order_ids and copy into validated_status worksheet
    'column H contains order_ids
    .Range("H2:H" & LastRow).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Worksheets("validated_status").Range("A2:A" & LastRow), Unique:=True

    'start from 2 because of header row
    Set firstid = .Range("H" & 2)


    For j = 1 to LastRow

        Do until firstid.offset(j,0).value <> firstid.value
            j = j + 1
        Loop

        For k = 2 to j

            Set validated_status_range = Worksheets("validated_status").Range("B" & Application.WorksheetFunction.Match(.Range("H" & k).Value, Worksheets("validated_status").Range("A:A")))
            Set order_id_set = .range("H" & k & ":H" & j)
            Set status_return = order_id_set.Find("return")
            Set status_pending = order_id_set.Find("pending")
            Set status_invalid = order_id_set.Find("invalid")
            Set status_cancelled = order_id_set.Find("cancelled")
            Set status_completed = order_id_set.Find("completed")

            If Not status_pending Is Nothing Then
                validated_status_range.Value = "Rejected"
            ElseIf Not status_return Is Nothing Then
                validated_status_range.Value = "Rejected"
            ElseIf Not status_invalid Is Nothing Then
                validated_status_range.Value = "Rejected"
            ElseIf Not status_cancelled Is Nothing Then
                validated_status_range.Value = "Rejected"
            ElseIf Not status_completed Is Nothing Then
                validated_status_range.Value = "Approved"
            End If

            k = k + j

        Next k

    Next j

End with

End Sub

这可能不是为我的问题编写代码的最优雅的方式，但我希望你们所有善良的人都可以为我揭示这一点。谢谢!!

Answer 1

标准公共模块代码表的代码似乎符合您的期望。

Option Explicit

Sub lastStatus()
    Dim arr As Variant, d As Long, dict As Object

    Set dict = CreateObject("scripting.dictionary")

    With Worksheets("sheet3")
        arr = .Range(.Cells(2, "A"), Cells(.Rows.Count, "B").End(xlUp)).Value2

        For d = LBound(arr, 1) To UBound(arr, 1)
            If Not dict.exists(arr(d, 1)) Then
                Select Case LCase(arr(d, 2))
                    Case "pending"
                        dict.Add Key:=arr(d, 1), Item:="pending"
                    Case "cancelled"
                        dict.Add Key:=arr(d, 1), Item:="rejected"
                    Case "completed"
                        dict.Add Key:=arr(d, 1), Item:="approved"
                    Case Else
                        'do nothing
                End Select
            Else
                Select Case LCase(arr(d, 2))
                    Case "pending"
                        dict.Item(arr(d, 1)) = "pending"
                    Case "cancelled"
                        If dict.Item(arr(d, 1)) <> "pending" Then _
                            dict.Item(arr(d, 1)) = "rejected"
                    Case Else
                        'do nothing
                End Select
            End If
        Next d

        .Cells(2, "D").Resize(dict.Count, 1) = Application.Transpose(dict.keys)
        .Cells(2, "E").Resize(dict.Count, 1) = Application.Transpose(dict.items)
    End With
End Sub

Answer 2

在您的代码中，您说＆＃34;列H包含order_ids＆＃34; ，因此.Range("H2:H" & LastRow).AdvancedFilter...代码行实际上正在复制其唯一值来自＆＃34;要更新＆＃ 34;表格列H到＆＃34; validated_status＆＃34;表格栏A

但是在后续代码中，所有Find()方法都会在您设置为order_id_set的{{1}}范围内调用，即再次调用到列H，而它必须是不同的列

所以，假设＆＃34; validated_status＆＃34;值在＆＃34;要更新＆＃34;表格列I，这里有一个可能的代码：

Set order_id_set = .range("H" & k & ":H" & j)

如果你想坚持Option Explicit Sub main() Dim dict As Object Dim key As Variant Dim cell As Range Set dict = CreateObject("Scripting.Dictionary") With Worksheets("To update") For Each cell In .Range("H2:H" & .Cells(.Rows.Count, "A").End(xlUp).Row) 'loop through "order_id" column dict(cell.value) = dict(cell.value) & cell.Offset(, 1) ' joining all "order_status" values from column I associated to the same "order_id" Next For Each key In dict.keys Select Case True Case InStr(dict(key), "pending") > 0 dict(key) = "pending" Case InStr(dict(key), "cancelled") > 0 dict(key) = "rejected" Case InStr(dict(key), "complete") > 0 dict(key) = "approved" End Select Next End With With Worksheets("validated_status") With .Range("B1", .Cells(.Rows.Count, 1).End(xlUp)) .ClearContents .Resize(1).value = Array("order_id", "validated_status") .Resize(UBound(dict.keys) + 1, 1).Offset(1, 0).value = Application.Transpose(dict.keys) .Resize(UBound(dict.keys) + 1, 1).Offset(1, 1).value = Application.Transpose(dict.items) End With End With End Sub方法，那么你可以编码：

AdvancedFilter

VBA确定唯一交易ID的批准状态（众多类似的ID）

2 个答案: