Я немного устарел со своим VBA, особенно с массивами. У меня есть код ниже, цель которого -
- захватить значения в заданном диапазоне
- удалить любые дубликаты
- удалить какое-то значение на основе критериев (например: удалить пробелы, удалите записи, начинающиеся с 7, et c.)
- Мне нужен размер конечного диапазона или массива, чтобы правильно вставить его в лист после
Function AllAddedParts(FullFilePath As String) As Variant
Dim arrValues As Variant
Dim arrUnikVals As String
On Error GoTo ErrHandler
Application.ScreenUpdating = False
Dim src As Workbook
' OPEN THE SOURCE EXCEL WORKBOOK IN "READ ONLY MODE".
Set src = Workbooks.Open(FullFilePath, True, True)
' GET THE TOTAL ROWS FROM THE SOURCE WORKBOOK.
Dim iTotalRows As Integer
TotalRows = src.Worksheets("Add - Cancel Report (EV6)").Range("D1:D" & Cells(Rows.Count, "D").End(xlUp).Row).Rows.Count
' COPY DATA FROM SOURCE (CLOSE WORKGROUP) TO THE DESTINATION WORKBOOK.
Dim iCnt As Integer ' COUNTER.
Dim ArrDim As Long: ArrDim = 0
arrValues = src.Worksheets("Add - Cancel Report (EV6)").Range("D4:D" & TotalRows)
' CLOSE THE SOURCE FILE.
src.Close False ' FALSE - DON'T SAVE THE SOURCE FILE.
Set src = Nothing
' Reove Duplicates
arrUnikVals = RemoveDupesColl(arrValues)
ErrHandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Function
Затем это вызывает эту функцию:
Function RemoveDupesColl(MyArray As Variant) As Variant
Dim i As Long
Dim arrColl As New Collection
Dim arrDummy As Variant
Dim arrDummy1 As Variant
Dim item As Variant
ReDim arrDummy1(LBound(MyArray) To UBound(MyArray))
ThisWorkbook.Worksheets("Sheet1").Range("a2:a66") = MyArray
For i = LBound(MyArray) To UBound(MyArray) 'convert to string
arrDummy1(i) = CStr(MyArray(i)) '<------------------THIS IS WHERE I GET THE ERROR, Type mismatch
Next i
On Error Resume Next
For Each item In arrDummy1
arrColl.Add item, item
Next item
Err.Clear
ReDim arrDummy(LBound(MyArray) To arrColl.Count + LBound(MyArray) - 1)
i = LBound(MyArray)
For Each item In arrColl
arrDummy(i) = item
i = i + 1
Next item
RemoveDupesColl = arrDummy
End Function
Полагаю, это связано с тем, как я объявил ArrValues и MyArray? Но я не знаю, как это исправить.
Заранее спасибо за вашу помощь!