Question

我希望使用数组将数据从Excel工作表导出到多个CSV文件，我编写了创建导出文件的代码，但没有出现问题，但是我似乎无法全神贯注地将初始值分配给数组，然后从数组中的数据使用某种while循环来产生所需的导出。

我希望保留在数组中的唯一值位于工作表1的A列中，显然该列中的值不是唯一的，但我只希望引用一次（添加到数组中）。

一旦数组中有值，我想将代码放入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

将值分配给数组以在while循环中使用

1 个答案: