Присвоение значений массиву для использования в цикле while

Question

Я хочу экспортировать данные из листа Excel в несколько файлов CSV с использованием массива. Я написал код, который создает экспорт без проблем, но я не могу придумать, как присвоить начальные значения массиву изатем используя какой-то цикл while из данных в массиве для получения желаемого экспорта.

Уникальные значения, которые я хочу сохранить в массиве, находятся в столбце A листа 1, очевидно, значения в столбцене являются уникальными, но я хочу только сослаться (добавить в массив) один раз.

Как только у меня появятся значения в массиве, я хочу поместить код в цикл while для экспорта данных, основанных на уникальномзначение в массиве.

Ниже приведен фрагмент моего текущего кода, который изолированно работает нормально;

Public InvDate

Sub ExportAccLinesLoop()
    Dim fso, FilePathName, FilePath, Station, StationName, StationDate, Exp, d1, WC, dd, mm, yy
    dd = Left(InvDate, 2)
    mm = Mid(InvDate, 4, 2)
    yy = Right(InvDate, 2)
    FilePath = "\\Sunbury-xxx\xxx\Parcels\Attachments\"
    FilePathName = FilePath & "Tmp.csv"
    Worksheets("Sheet1").Activate
    Set rRange = Worksheets("Sheet1").Range("A1", Range("A" & Rows.Count).End(xlUp))
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(FilePath) Then fso.CreateFolder (FilePath)  'create folder if it does not exist
    Set inputFile = fso.OpenTextFile(FilePathName, 8, True)
    inputFile.WriteLine (Chr(34) & "Rate Acc" & Chr(34) & "," & Chr(34) & "Movement" & Chr(34) & "," & Chr(34) & "Ledger Acc" & Chr(34))  ‘Write Header values
    inputFile.Close

    For Each rCell In rRange
        If rCell.Value = "WAR" Then
            RateAcc = rCell(1, 1)
            DelCol = rCell(1, 2)
            LedgerAcc = rCell(1, 3)            

            If Not fso.FolderExists(FilePath) Then fso.CreateFolder (FilePath)  'create folder if it does not exist
            Set inputFile = fso.OpenTextFile(FilePathName, 8, True)
            inputFile.WriteLine (Chr(34) & RateAcc & Chr(34) & "," & Chr(34) & DelCol & Chr(34) & "," & Chr(34) & LedgerAcc & Chr(34))  ‘Write Line values

            inputFile.Close
        End If 'rCell
    Next rCell
    fso.CopyFile FilePathName, FilePath & yy & mm & dd & "-" & LedgerAcc & "-" & RateAcc & "-" & "TRAN.csv" 'Copy Tmp.csv to correct filename
    fso.DeleteFile FilePathName 'Delete Tmp.csv

End Sub

Я предполагаю, что цикл while начнется после Set rRange, действительно уникальные значения Array будут приходить из того же диапазона, но я застрял.

Есть идеи?

Answer 1

Dim objDict As Object
Dim key As Variant

Set objDict = CreateObject("System.Collections.ArrayList")

With ThisWorkbook.ActiveSheet
    With .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
        For Each key In .Value
            If Not objDict.Contains(key) Then objDict.Add key
        Next
    End With
End With