唯一值两列组合框 vba

Question

我需要在具有唯一值的组合框中显示两列 A 和 B。因此，如果两行具有相同的 A 但不同的 B，则它不是重复的，两列都需要重复。我找到了一个代码，其中列出了具有唯一值的一列 (A)，但我不知道如何添加列 B。

有一张我的数据的图片以及我想如何在我的 ComboBox 中显示它。

代码如下：

Private Sub UserForm_Initialize()

    Dim Cell        As Range
    Dim col         As Variant
    Dim Descending  As Boolean
    Dim Entries     As Collection
    Dim Items       As Variant
    Dim index       As Long
    Dim j           As Long
    Dim RngBeg      As Range
    Dim RngEnd      As Range
    Dim row         As Long
    Dim Sorted      As Boolean
    Dim temp        As Variant
    Dim test        As Variant
    Dim Wks         As Worksheet

        Set Wks = ThisWorkbook.Worksheets("Sheet1")

        Set RngBeg = Wks.Range("A3")
        col = RngBeg.Column

        Set RngEnd = Wks.Cells(Rows.Count, col).End(xlUp)

            Set Entries = New Collection
            ReDim Items(0)

            For row = RngBeg.row To RngEnd.row
                Set Cell = Wks.Cells(row, col)
                    On Error Resume Next
                        test = Entries(Cell.Text)
                        If Err = 5 Then
                            Entries.Add index, Cell.Text
                            Items(index) = Cell.Text
                            index = index + 1
                            ReDim Preserve Items(index)
                        End If
                    On Error GoTo 0
            Next row

        index = index - 1
        Descending = False
        ReDim Preserve Items(index)

            Do
                Sorted = True

                For j = 0 To index - 1
                    If Descending Xor StrComp(Items(j), Items(j + 1), vbTextCompare) = 1 Then
                        temp = Items(j + 1)
                        Items(j + 1) = Items(j)
                        Items(j) = temp

                        Sorted = False
                    End If
                Next j

                index = index - 1
            Loop Until Sorted Or index < 1

        ComboBox1.List = Items


End Sub

有什么线索吗？谢谢！

Answer 1

请试试这个代码。它假设 unique 定义意味着来自同一行的两列的值对是唯一的：

Sub UnicTwoValInTwoColumns()
  Dim sh As Worksheet, arr As Variant, arrFin As Variant, countD As Long
  Dim lastRow As Long, i As Long, j As Long, k As Long, boolDupl As Boolean

  Set sh = ActiveSheet 'use here your sheet
  'supposing that last row in column A:A is the same in column B:B
  'If not, the last row for B:B will be calculated and then the higher will be chosen:
  lastRow = sh.Range("A" & Rows.Count).End(xlUp).Row
  ReDim arrFin(1 To 2, 1 To lastRow)    'redim the final array for maximum possible number of elements
  arr = sh.Range("A3:B" & lastRow).value 'pun in array the range to be analized
  k = 1 'initialize the first array element number

  For i = 1 To UBound(arr, 1) 'iterate between the array elements
    boolDupl = False  'initialize the variable proving that the pair of data already in arrFin
    For j = 1 To k    'iterate between the arrFin elements in order to check for duplicates
        If arr(i, 1) & arr(i, 2) = arrFin(1, j) & arrFin(2, j) Then
              boolDupl = True: Exit For 'if a duplicate is found the loop is exited
        End If
    Next j
    If Not boolDupl Then 'load the arrFin only if a duplicate has not been found
        arrFin(1, k) = arr(i, 1): arrFin(2, k) = arr(i, 2)
        k = k + 1        'increment the (real) array number of elements
    End If
  Next
  ReDim Preserve arrFin(1 To 2, 1 To k - 1) 'redim array at the real dimension (preserving values)
  With Me.ComboBox1
      .ColumnCount = 2 'be sure that combo has 2 columns to receive values
      .List = WorksheetFunction.Transpose(arrFin) 'fill the combo with the array elements
  End With
End Sub

您可以将代码粘贴到表单初始化事件中，或者让Sub照原样，将其复制到表单模块中，然后仅从讨论中的事件中调用它。我建议你以这种方式进行。如果您在活动中有（或将有）其他事情，我认为如果发生问题，识别问题会更简单，