Question

我尝试从一个工作表中搜索一列单元格，找到所有唯一值，然后将这些值粘贴到另一个工作表中的列中。到目前为止，我有代码创建一个字典，搜索所需的列，并选择该列中的所有唯一值。

Function UniqueRequest() As Long

        myReqIDCol = ColSearch("id")

        'Creates a dictionary filled with each unique value in the "TaskIDList" column and counts them to determine how many unique keys are in the document
        Set dic = CreateObject("Scripting.Dictionary")
        For i = 1 To LastRow
            tmp = Cells(i, myReqIDCol).Value
            If Not dic.exists(tmp) Then
                dic.Add tmp, 1
            End If
        Next i

End Function

我还有一个函数可以选择要粘贴单元格的工作表并将其设置为将其粘贴到所需列中的每个连续空白单元格中。

Function ReqSheet(input_column As Integer, input_value As Long) As Long

        Dim rv As Long

            rv = 1

            Sheets("Request Results").Activate
            Do While Cells(rv, input_column).Value <> ""
                rv = rv + 1
            Loop
            Cells(rv, input_column).Value = input_value

    ReqSheet = input_value

    End Function

我遇到的问题是，我不完全确定如何将这两者联系起来。我想用字典的每个值调用ReqSheet函数，但我尝试过的所有内容都失败了。很抱歉，如果这是一个简单的解决方案，但我无法从互联网上找到一个很好的解决方案，而且我对VBA来说还是一个新手。

Answer 1

关于字典的一个好处是你可以将它们的值和键拉出到一个数组中，然后一次性写入一个范围而不需要循环。

Sub GetUnique()

    Dim dc As Scripting.Dictionary
    Dim rCell As Range

    Set dc = New Scripting.Dictionary

    For Each rCell In Selection.Cells
        If Not dc.Exists(rCell.Value) Then
            dc.Add rCell.Value, rCell.Value
        End If
    Next rCell

    ThisWorkbook.Worksheets("Request Results").Range("A1").Resize(UBound(dc.Keys), 1).Value = _
        Application.Transpose(dc.Keys)

End Sub

Answer 2

这些方面应该有所作为。您只需要使用适当的变量或方法替换input_column即可找到该列。

Function UniqueRequest() As Long

myReqIDCol = ColSearch("id")

'Creates a dictionary filled with each unique value in the "TaskIDList" column and counts them to determine how many unique keys are in the document
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To LastRow
    tmp = Cells(i, myReqIDCol).Value
    If Not dic.exists(tmp) Then
        dic.Add tmp, 1
    End If
Next i


For each _Value in dic

    ReqSheet(input_column, _Value)

Next


End Function

Answer 3

使用此代码并将列更改为您要使用的任何内容。

Function UniqueRequest() As Long

        myReqIDCol = ColSearch("id")

        'Creates a dictionary filled with each unique value in the "TaskIDList" column and counts them to determine how many unique keys are in the document
        Set dic = CreateObject("Scripting.Dictionary")
        For i = 1 To LastRow
            tmp = Cells(i, myReqIDCol).Value
            If Not dic.exists(tmp) Then
                dic.Add tmp, 1
            End If
        Next i

For Each value in dic.keys 
  ReqSheet(4,value)  'I have taken column 4,you can change it to any no you want.      
End Function

将字典存储在另一个工作表中的单元格中的VBA粘贴单元格

3 个答案: