Question

我正在尝试处理数据文件并将每个部分导出到单独的文本文件中。我可以指定一个没有问题的导出范围（A1：A58），但我不知道我需要多少行，所以它应该是动态的。例如，sheet1将导出58行，因为第1行将始终开始范围（A1），58（A58）包含文本＆＃34;引用＆＃34;表示该记录的结束。然后，这些行将被删除。下一条记录将以特定文字＆＃34; NewRecord＆＃34;开头。（A1）并填写“＆＃34;引用＆＃34;再次。

Sub ExportRange()
Dim c As Range, r As Range
Dim output As String
Dim MyFolder As String
Dim MyFile As String
Dim i As Long
Dim MyOldFile As String
Dim MyNewFile As String
MyFolder = "C:\Users\profile\Documents\test"
MyFile = Dir(MyFolder & "\text.txt")
i = i + 1
MyOldFile = MyFolder & "\" & MyFile
MyNewFile = MyFolder & "\" & Sheets("Sheet1").Range("B20") & "_" & i & ".txt"
For Each r In Range("A1:A37").Rows
    For Each c In r.Cells
        output = output & "," & c.Value
        Next c
    output = output & vbNewLine
Next r
Open "C:\Users\profile\Documents\test\Text.txt" For Output As #1
Print #1, output
Close
Name MyOldFile As MyNewFile
MyFile = Dir
Close
End Sub

Answer 1

这将找到第一行包含＆＃34;引用＆＃34;从上到下搜索并从For循环中使用它创建一个范围。

Sub ExportRange()
Dim c As Range, r As Range, LoopRange as Range
Dim output As String
Dim MyFolder As String
Dim MyFile As String
Dim i As Long
Dim MyOldFile As String
Dim MyNewFile As String
Set LoopRange = Range("A1", Cells(Range("A:A").Find(what:="Referring", after:=Range("A1"), searchdirection:=xlNext).Row, "A"))
MyFolder = "C:\Users\profile\Documents\test"
MyFile = Dir(MyFolder & "\text.txt")
i = i + 1
MyOldFile = MyFolder & "\" & MyFile
MyNewFile = MyFolder & "\" & Sheets("Sheet1").Range("B20") & "_" & i & ".txt"
For Each r In LoopRange.Rows
    For Each c In r.Cells
        output = output & "," & c.Value
        Next c
    output = output & vbNewLine
Next r
Open "C:\Users\profile\Documents\test\Text.txt" For Output As #1
Print #1, output
Close
Name MyOldFile As MyNewFile
MyFile = Dir
Close
End Sub

vba定义范围结束文本

1 个答案: