VBA計數器忽略重復項

我正在努力改變我的宏中的計數器。我剛開始我的 VBA 冒險，花了一整天的時間查看論壇并嘗試了許多代碼，但沒有任何效果。

我有一個代碼可以檢查表中的許多條件。在 FI 列中列出了唯一值。在 AE 列中，我具有相同的值，但其中一些是重復的，例如 2 或 3 行。現在我的代碼檢查列 F 中的值是否存在于列 AE 中，然后檢查其他條件，例如 AH 列中是否存在“OB”以及更多條件。然后它會計算它找到的值的數量，但它也會計算重復值。我需要將其更改為僅計算 AH 列中的唯一值。因此，假設值 X 在 AE2 和 AE4 中重復，并且它們在 AH 列中都有“OB”，那么計數器只顯示 1。有人可以解釋一下我該怎么做嗎？

因此，如果您查看示例，我在 F 列中有一個唯一值串列。 AE 列包含相同的值，但在重復的行中。例如，宏的第一部分檢查 AE 列中的值是否在 AH 列中具有“OB”并在 J2 中顯示計數器。但是現在它顯示 7，因為它在 AH 中找到了 7 行帶有“OB”的值，但我需要它顯示 3，因為這些值是重復的。稍后的宏檢查值是否在 AH 列中具有“OB”，以及在 AM 列中是否不同于 0。然后它顯示 K2 中的第二個計數器。現在它顯示 3，因為它找到了具有兩個條件的 3 行，但我需要它顯示 1，因為它是相同的值。

我的代碼：

   Dim lr1 As Long
       lr1 = Cells(Rows.count, "F").End(xlUp).Row
   Dim lr2 As Long
       lr2 = Cells(Rows.count, "AE").End(xlUp).Row
   Dim count As Long
   Dim counter As Long   
   Dim x As Long
   Dim y As Long


'????????????????? CHECK IF MATERIAL IS USED IN ACTIVE BOM ?????????????????


'Loop in both ranges
   For x = 3 To lr1
       For y = 3 To lr2
           If range("F" & x) = range("AE" & y) Then
'If material is set to OB
               If UCase(range("AH" & y)) = "OB" Then
                   'And is used in BoM
                   If range("AO" & y) <> "" Then
                       'And BoM is not OB
                       If UCase(range("AP" & y)) <> "OB" Then
                           'Add to counter
                           count = count   1
             '  range("F" & x).Interior.ColorIndex = 3
                        End If
                   End If
               End If
           End If
       Next y
   Next x
   
'Display results in J2
   If count > 0 Then
       range("J2") = count & " found"
       range("J2").Font.Color = vbRed
       
   Else
       range("J2") = "None"
       range("J2").Font.ColorIndex = 10
   End If
   
   
   
'????????????????? CHECK IF MATERIAL IS ON STOCK ?????????????????

'Loop in both ranges
   For x = 3 To lr1
       For y = 3 To lr2
           If range("F" & x) = range("AE" & y) Then
'If material is set to OB
           If UCase(range("AH" & y)) = "OB" Then
'And is on stock
           If range("AM" & y) <> "0" Then
'Add to counter
               counter = counter   1
           End If
           End If
           End If
       Next y
   Next x
   
   
'Display results in K2
   If counter > 0 Then
       range("K2") = counter & " on stock"
       range("K2").Font.Color = vbRed
       
   Else
       range("K2") = "None"
       range("K2").Font.ColorIndex = 10
   End If

uj5u.com熱心網友回復：

你在這里。代碼首先檢查列 AE 中的值是否存在于唯一值串列中，以及列 AH = "OB"。

如果此唯一值尚未添加到唯一集合中，則將添加該唯一值并增加唯一計數，否則將其忽略。

Function Condition1()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim uniqueRange As Range: Set uniqueRange = ws.Range("F2:F9")
Dim checkList As Collection

Dim i As Integer
Dim UniqueCounter As Integer

Set checkList = New Collection
For i = 2 To 15
    Dim findStr As String
    findStr = ws.Cells(i, "AE")
    If Not uniqueRange.Find(findStr, LookIn:=xlValues) Is Nothing And ws.Cells(i, "AH") = "OB" Then  'Check if Value exists in master, if not ignore
        Dim keyExists As Variant
        On Error Resume Next
        keyExists = Empty
        keyExists = checkList(findStr)
        On Error GoTo 0
        If IsEmpty(keyExists) Then
            UniqueCounter = UniqueCounter   1
            checkList.Add findStr, findStr
        End If
    End If
Next
Condition1 = UniqueCounter
End Function
 

標籤：擅长vba

上一篇：Excel日期過濾器選項或VBA

下一篇：在任務項中設定附件的位置在Outlook2019中不起作用