VBA具有第二個條件的唯一值計數

Question

我遇到了一個障礙，試圖思考如何編寫VBA代碼，該代碼將計算唯一訂單號的數量以及每個銷售人員的訂單狀態為打開還是關閉。

我正在編寫會影響Sheet2的VBA。 我需要VBA遍歷Sheets（“ Sheet2”）。Range（“ A：A”）和（1）在Sheet1中查找名稱； （2a）計算與銷售員姓名相對應的唯一訂單號為“未清”，而（2b）計算與銷售員姓名相對應的唯一訂單號為“已關閉”。 我為要使用宏計算的值設計了“？”，並包含了答案數字。

任何幫助是極大的贊賞。 請讓我知道是否可以澄清任何事情。

表格1-訂單

Sheet2-訂單摘要

       A                   B                            C    
1  **Name**   **Count-Uniq Open Orders**   **Count-Uniq Closed Orders**
2   John              ? (answer: 2)                ? (answer: 0)
3   Ben               ? (answer: 1)                ? (answer: 1)
4   Fred              ? (answer: 1)                ? (answer: 0)       

Answer 1

測試：

Sub Tester()

Dim d1, d2, arrIn, r, tmp, nm, id, i
Dim c, k

    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")

    With Sheets("orders")
        arrIn = .Range(.Range("A2"), _
                       Cells(Rows.Count, 3).End(xlUp)).Value
    End With

    For r = 1 To UBound(arrIn, 1)
        nm = arrIn(r, 1) 'name
        id = arrIn(r, 2) 'order #
        If Not d1.exists(nm) Then
            d1.Add nm, Array(0, 0)
        End If
        If Not d2.exists(id) Then
            tmp = d1(nm)
            i = IIf(UCase(arrIn(r, 3)) = "OPEN", 0, 1)
            tmp(i) = tmp(i) + 1
            d1(nm) = tmp
            d2.Add id, 0
        End If
    Next r

    Set c = Sheets("summary").Range("a2")
    For Each k In d1.keys
        c.Resize(1, 3).Value = Array(k, d1(k)(0), d1(k)(1))
        Set c = c.Offset(1, 0)
    Next k
End Sub

Answer 2

試試這個:)

Sub Macro1()

    Dim ws1 As Worksheet, ws2 As Worksheet, wsTemp As Worksheet
    Dim rng As Range
    Dim myformula1 As String, myformula2 As String

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set ws1 = ThisWorkbook.Sheets("Sheet1") 'where you have your Orders
    Set ws2 = ThisWorkbook.Sheets("Sheet2") 'where you have your summary which should have names in it
    ws1.Copy ThisWorkbook.Sheets(1)
    Set wsTemp = ActiveSheet: wsTemp.Name = "Temp"

    With wsTemp
        Set rng = .UsedRange
        rng.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
    End With

    myformula1 = "=COUNTIFS(" & wsTemp.Name & "!A:A,A2," & wsTemp.Name & "!C:C,""Open"")"
    myformula2 = "=COUNTIFS(" & wsTemp.Name & "!A:A,A2," & wsTemp.Name & "!C:C,""Closed"")"

    With ws2.Range(ws2.Range("A2"), ws2.Range("A" & ws2.Rows.Count).End(xlUp))
        .Offset(0, 1).Formula = myformula1
        .Offset(0, 2).Formula = myformula2
        .Offset(0, 1).Resize(, 2).Value = .Offset(0, 1).Resize(, 2).Value
    End With

    wsTemp.Delete
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With

End Sub

沒有循環。 只是給你一個替代方案：D
希望這對您有幫助。

Answer 3

在工作表B2的單元格B2中：

=SUM(IF(FREQUENCY(IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=B$1,Sheet1!$B$2:$B$10)),IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=B$1,Sheet1!$B$2:$B$10)))>0,1))

這是一個數組公式，因此要確認按住Ctrl + Shift並按Enter ，將分別在開始和結束處添加一個{和} 。

在單元格C3中：

=SUM(IF(FREQUENCY(IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=C$1,Sheet1!$B$2:$B$10)),IF(Sheet1!$A$2:$A$10=$A2,IF(Sheet1!$C$2:$C$10=C$1,Sheet1!$B$2:$B$10)))>0,1))

同樣，它是一個數組，因此按Ctrl + Shift並按Enter

然后將公式復制下來。

Answer 4

作為替代方案，在數據透視表解決方案方面，以下答案涵蓋了所需的技術：

簡單數據透視表以計算唯一值