Create CSV from array in VBA

前端 未结 2 1087
北恋
北恋 2021-01-15 02:25

I\'m a novice programmer trying to automate some repetitive workplace tasks that should be done by a clever script instead of humans. I\'ve done some VBA and Java, but very

2条回答
  •  清歌不尽
    2021-01-15 03:13

    The code below works for converting 2D arrays in CSV. I have not written the code, but have tested it and it works!

    ' SaveAsCSV saves an array as csv file. Choosing a delimiter different as a comma, is optional.
    '
    ' Syntax:
    ' SaveAsCSV dMyArray, sMyFileName, [sMyDelimiter]
    '
    ' Examples:
    ' SaveAsCSV dChrom, app.path & "\Demo.csv"       --> comma as delimiter
    ' SaveAsCSV dChrom, app.path & "\Demo.csv", ";"  --> semicolon as delimiter
    '
    ' Rev. 1.00 [8 jan 2003]
    ' written by P. Wester
    ' wester@kpd.nl
    
    
    Public Sub SaveAsCSV(MyArray() As Variant, sFilename As String, Optional sDelimiter As String = ",")
    
    Dim n As Long 'counter
    Dim M As Long 'counter
    Dim sCSV As String 'csv string to print
    
    On Error GoTo ErrHandler_SaveAsCSV
    
    
    'check extension and correct if needed
    If InStr(sFilename, ".csv") = 0 Then
      sFilename = sFilename & ".csv"
    Else
      While (Len(sFilename) - InStr(sFilename, ".csv")) > 3
        sFilename = Left(sFilename, Len(sFilename) - 1)
      Wend
    End If
    
    'If MultiDimensional(MyArray()) = False Then '1 dimension
    
      'save the file
    '  Open sFileName For Output As #7
    '  For n = 0 To UBound(MyArray(), 1)
    '    Print #7, Format(MyArray(n, 0), "0.000000E+00")
    '  Next n
    '  Close #7
    
    'Else 'more dimensional
    
      'save the file
      Open sFilename For Output As #7
      For n = 1 To UBound(MyArray(), 1)
        sCSV = ""
        For M = 1 To UBound(MyArray(), 2)
          sCSV = sCSV & Format(MyArray(n, M)) & sDelimiter
        Next M
        sCSV = Left(sCSV, Len(sCSV) - 1) 'remove last Delimiter
        Print #7, sCSV
      Next n
      Close #7
    
    'End If
    
    Exit Sub
    
    
    ErrHandler_SaveAsCSV:
      Close #7
    

提交回复
热议问题