我正在开发一个项目,该项目涉及在电子表格中查找特定列,然后仅将该列中的唯一值存储到数组中,然后将该数组打印在另一个工作表上。我的代码由于类型不匹配和没有设置块而错误输出,但我似乎无法找出原因。任何帮助将不胜感激。
Option Explicit
Sub Find_Distincts_Policies()
Dim aCell As Range, rng As Range
Dim varIn As Variant, varUnique As Variant, element As Variant
Dim isUnique As Boolean
Dim ws As Worksheet
Dim wkb As Workbook
Dim colName As Long
Dim i As Long, j As Long, k As Long
Dim iInCol As Long, iInRow As Long, iUnique As Long, nUnique As Long, LastRow As Long
Set wkb = ThisWorkbook
Set ws = wkb.Worksheets("Sheet2")
With ws
Set aCell = .Range("A1:ZZ4").Find(what:="Unique Number", LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not aCell Is Nothing Then
colName = Split(.Cells(, aCell).Address, "$")(1)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set rng = .Range(colName & "2:" & colName & LastRow)
varIn = rng.Value
ReDim varUnique(1 To UBound(varIn, 1) * UBound(varIn, 2))
nUnique = 0
For iInRow = LBound(varIn, 1) To UBound(varIn, 1)
For iInCol = LBound(varIn, 2) To UBound(varIn, 2)
isUnique = True
For iUnique = 1 To nUnique
If varIn(iInRow, iInCol) = varUnique(iUnique) Then
isUnique = False
Exit For
End If
Next iUnique
If isUnique = True Then
nUnique = nUnique + 1
varUnique(nUnique) = varIn(iInRow, iInCol)
End If
Next iInCol
Next iInRow
ReDim Preserve varUnique(1 To nUnique)
MsgBox varUnique
Else: Exit Sub
End If
End With
With wkb
.Worksheets.Add.Name = "Unique values"
ActiveSheet.Range("A1") = varIn
End With
End Sub