Question

我正在处理一些数据，我想从列中提取唯一值并将它们存储在一个数组中，然后将其用于其他计算。

Sub A_Unique_B()
Dim X
Dim objDict As Object
Dim lngRow As Long

Set objDict = CreateObject("Scripting.Dictionary")
X = Application.Transpose(Range([E1], Cells(Rows.Count, "E").End(xlUp)))

For lngRow = 1 To UBound(X, 1)
objDict(X(lngRow)) = 1
Next
Range("K1:K" & objDict.Count) = Application.Transpose(objDict.keys)
End Sub

The Data set is found here. 现在我希望代码使用一个输入框来输入，该列用于搜索（此处为[E1]）以获取唯一值以及存储输出的位置（此处为“K1：K”）。

Answer 1

使用变量添加InputBox代码以保存其值：

Dim col As String
Dim output_col As String
col = InputBox("Type the column letter to search in", "Data Input")
output_col = InputBox("Type the column letter to write results to", "Data Input")

并添加一些逻辑，例如，如果列字母长度不是0，则处理。

Sub A_Unique_B()
Dim X
Dim objDict As Object
Dim lngRow As Long

Dim col As String
Dim output_col As String
col = InputBox("Type the column letter to search in", "Data Input")
output_col = InputBox("Type the column letter to write results to", "Data Input")
If Len(col) > 0 And Len(output_col) > 0 Then
  Set objDict = CreateObject("Scripting.Dictionary")
  X = Application.Transpose(Range(col & CStr(1), Cells(Rows.Count, col).End(xlUp)))
  For lngRow = 1 To UBound(X, 1)
    objDict(X(lngRow)) = 1
  Next
  Range(output_col & CStr(1) & ":" & output_col & objDict.Count) = Application.Transpose(objDict.keys)
End If
End Sub

使用输入框存储唯一值

1 个答案: