Несоответствие типов массивов - PullRequest
0 голосов
/ 10 июля 2020

Я немного устарел со своим VBA, особенно с массивами. У меня есть код ниже, цель которого -

  1. захватить значения в заданном диапазоне
  2. удалить любые дубликаты
  3. удалить какое-то значение на основе критериев (например: удалить пробелы, удалите записи, начинающиеся с 7, et c.)
  4. Мне нужен размер конечного диапазона или массива, чтобы правильно вставить его в лист после
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? Но я не знаю, как это исправить.

Заранее спасибо за вашу помощь!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...