vba遍歷範圍寫入csv

Question

我寫過這個宏，它應該循環遍歷一個範圍，如果該範圍包含一個數字，然後將偏移單元複製到一個csv或另一個表。目前，當我執行代碼時，它會突破，但是在我的文本文件中沒有輸出，也沒有任何錯誤消息。

我不知道發生了什麼事？任何指針？請幫助謝謝。

Dim rng As Range, cell As Range 
Dim ofset As String 
Dim filepath As String 

Set rng = Range("F1:F100") 

For Each cell In rng 
    If IsError(cell) Then 
    'MsgBox "cell " & cell.Address & " contains error" 
    ElseIf cell.Value > 0 Then 
    ofset = cell.Offset(, -2).Resize(, 2).Select 'gives you B1:C1 
    ' copy this range to text file 
    filepath = Application.DefaultFilePath & "\authors.csv" 
    Open filepath For Output As #2 

    Write #2, cell.Value & ofset 
    Close #2 

    End If 
Next cell 
MsgBox "The values have been copied" 

Answer 1

下面這段代碼似乎偏移單元格的值複製到CSV。它給出了預期的結果。現在，這已經足夠了，但是我會尋找一種方法來獲取這些值並將它們放在單獨的列中。

Sub Test3() 
Dim rng As Range, cell As Range 
Dim ofset As String 
Dim filepath As String 

Set rng = Range("F1:F100") 

For Each cell In rng 
If IsError(cell) Then 
'MsgBox "cell " & cell.Address & " contains error" 
ElseIf cell.Value > 0 Then 
    cell.Offset(, -2).Resize(, 2).Select 'gives you B1:C1 
' copy this range to text file 
filepath = "C:\Users\Jabaar\Documents\authors.csv" 
Open filepath For Append As #2 

    Write #2, cell.Value & " " & cell.Offset(, -2).Value & " " & cell.Offset(, -4).Value 
Close #2 

End If 
    Next cell 
    MsgBox "The data has been collected" 
End Sub 

Answer 2

每次傳遞文件日期是否更新？

數據末尾可能有空字符串。 如果你不想只得到了最後一個值，改變這種：

Open filepath For Output As #2 

到

Open filepath For Append As #2 

Dim rng As Range, cell As Range Dim ofset As String Dim filepath As String 

Set rng = Range("F1:F100") 

For Each cell In rng If IsError(cell) Then 
    'MsgBox "cell " & cell.Address & " contains error" ElseIf cell.Value > 0 Then 
    ofset = cell.Offset(, -2).Resize(, 2).Select 'gives you B1:C1 
    ' copy this range to text file 
    filepath = Application.DefaultFilePath & "\authors.csv" 
    Open filepath For Output As #2 

    oValues = "" 
    For each c in ofset 
     oValues=Ovalues & c.value 
    next 

    Write #2, cell.Value & oValues 
    Close #2 

    End If 
Next cell 

MsgBox "The values have been copied"