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

每次通过时文件日期是否更新？

数据末尾可能有一个空字符串。如果您不想只获取最后一个值，请更改：

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"

Answer 2

以下代码似乎将偏移单元格VALUES复制到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

vba循环通过范围写入csv

2 个答案: