2017-07-17 88 views
0

請耐心等待,因爲我對VBA非常陌生,以前的經驗主要來自Rhinoscript和其他專用腳本選項。這個問題真的很簡單,我估計有人可以很快回答這個問題,因爲我在VBA中的陣列很差:Excel變體數組內容到文件,加入行內容

我有一個電子表格,其目的是導入一些值和文本字符串(導致一些空白)進入例如答:升。這是手動完成的。我需要將這些值讀入數組,然後將它們打印到文件中,以便每個文件行對應於數組中的一行。目前我似乎無法將變體數組轉換爲字符串數組(顯然是必要的),然後將子數組連接到打印到文件中的臨時數組中。下面我設法湊到一起的結果是一個文件輸出,其中每個數組的值都在一行上,因爲我想要的是例如A1:L1單行打印。

Sub writerangetofile() 

'Write data to a text file 

'Declaring variables 
Dim valarray() As Variant 
Dim R As Long 
Dim C As Long 

'Set array as range 
Sheet1.Activate 
valarray() = Range("A1:L40") 

'Setting the name and the path of text file based on workbook path 
sFName = ThisWorkbook.Path & "\Output.txt" 

'Get an unused file number 
intFNumber = FreeFile 

'Create a new file (or overwrite an existing one) 
Open sFName For Output As #intFNumber 

For R = 1 To UBound(valarray, 1) ' First array dimension is rows. 
    For C = 1 To UBound(valarray, 2) ' Second array dimension is columns. 
     Print #intFNumber, valarray(R, C) 
    Next C 
Next R 

'Close the text file 
Close #intFNumber 

End Sub 

對於因爲我還沒有想出如何在它的任何內容獲得最後一排簡單,我只限於排40現在的範圍內。

關於如何完成我想要的優雅的任何想法?我已經通過將單個單元格分配給變量來解決此問題,但我寧願使用數組來完成它。最終,我將稍後在導入文本中的循環文本字符串之後插入一個固定文本字符串,然後再從計算中獲得一個數值。

非常感謝任何幫助和無知的道歉。

回答

0

如果您有任何問題,這個版本顯示瞭如何確定最後的行和列

Option Explicit 

Public Sub RangeToFile() 
    Dim ws As Worksheet, lr As Long, lc As Long, r As Long, c As Long 
    Dim arr As Variant, fName As String, fNumber As Long, txtLine As String 

    fName = ThisWorkbook.Path & "\Output.txt" 'File name & path based on workbook path 

    Set ws = Sheet1 'set a reference to main sheet 
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row   'find last row in column A 
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 'find last column in row 1 

    arr = ws.Range(ws.Cells(1, "A"), ws.Cells(lr, lc))  'Copy range to array 

    fNumber = FreeFile     'get next available file number assigned by windows 
    Open fName For Output As #fNumber 'create a new file, or overwrite an existing one 

    For r = 1 To UBound(arr, 1)     '1st array dimension is rows 
     For c = 1 To UBound(arr, 2)    '2nd array dimension is columns 
      txtLine = txtLine & arr(r, c) & ", " 'concatenate each cell in row, on a line 
     Next c          'the end of the row, moving to next one 
     txtLine = Left(txtLine, Len(txtLine) - 2) 'remove the extra comma at end of line 
     txtLine = txtLine & vbCrLf     'append a carriage return to the line 
    Next r 
    txtLine = Left(txtLine, Len(txtLine) - 2)  'remove carriage return at end of line 

    Print #fNumber, txtLine 'print entire text to the file with an extra carriage return 
    Close #fNumber   'close the text file 
End Sub 

而這一次調換列行:

Public Sub RangeToFileColumnsToRows() 
    Dim ws As Worksheet, lr As Long, lc As Long, r As Long, c As Long 
    Dim arr As Variant, fName As String, fNumber As Long, txtLine As String 

    fName = ThisWorkbook.Path & "\Output.txt" 'File name & path based on workbook path 

    Set ws = Sheet1 'set a reference to main sheet 
    lr = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row   'find last row in column A 
    lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column 'find last column in row 1 

    arr = ws.Range(ws.Cells(1, "A"), ws.Cells(lr, lc))  'Copy range to array 

    fNumber = FreeFile     'get next available file number assigned by windows 
    Open fName For Output As #fNumber 'create a new file, or overwrite an existing one 

    For c = 1 To UBound(arr, 2)     '2nd array dimension is columns 
     For r = 1 To UBound(arr, 1)    '1st array dimension is rows 
      txtLine = txtLine & arr(r, c) & ", " 'concatenate each cell in col, on a line 
     Next r          'the end of the col, moving to next one 
     txtLine = Left(txtLine, Len(txtLine) - 2) 'remove the extra comma at end of line 
     txtLine = txtLine & vbCrLf     'append a carriage return to the line 
    Next c 
    txtLine = Left(txtLine, Len(txtLine) - 2)  'remove carriage return at end of line 

    Print #fNumber, txtLine 'print entire text to the file 
    Close #fNumber   'close the text file 
End Sub 
0

沒關係,我想我向前邁進了一步:

For R = 1 To UBound(valarray, 1) ' First array dimension is rows. 

    For C = 1 To UBound(valarray, 2) ' Second array dimension is columns. 

     ReDim Preserve tvalarray(1 To C) 'Reset the array dimension on each iteration of loop whilst keeping results 
     'Input each single value into subarray for joining 
     tvalarray(C) = valarray(R, C) 
     'Join the subarray 
     jstring = Join(tvalarray) 

    Next C 

    ReDim Preserve jvalarray(1 To R) 'Reset the array dimension on each iteration of loop whilst keeping results 
    'Input the joined result into the new array 
    jvalarray(R) = jstring 
    'Print to file 
    Print #intFNumber, jvalarray(R) 

Next R 

這似乎做的工作,我去看看我碰到的陷阱後。