求助：根据某一列的不同数据，将第一列相同的几行，归类生成为txt

一把小刀闯天下

寻梦的谷 发表于 2019-3-15 16:09
谢谢你，我刚刚测试了下代码，发现可以完美运行
已经完成了我的最低要求啦
如果方便的话，可以帮我再升 ...

Option Explicit

Const START = 4 '开始行

Sub test1()
  Dim arr, i
  arr = [a1].CurrentRegion.Offset(1)
  Open ThisWorkbook.Path & "\" & arr(START, 1) & ".txt" For Output As #1
  For i = START To UBound(arr, 1) - 1
    Print #1, arr(i, 2) & ";" & arr(i, 3)
    If arr(i, 1) <> arr(i + 1, 1) Then
      Close #1
      If Len(arr(i + 1, 1)) Then Open ThisWorkbook.Path & "\" & arr(i + 1, 1) & ".txt" For Output As #1
    End If
  Next
End Sub

'或者==================================

Option Explicit

Const START = 4, NUM = 10 '每个站点的开始行、取连续数据个数

Sub test1()
  Dim arr, i, cnt
  arr = [a1].CurrentRegion.Offset(1)
  Open ThisWorkbook.Path & "\" & arr(1, 1) & ".txt" For Output As #1
  For i = 1 To UBound(arr, 1) - 1
    cnt = cnt + 1
    If cnt >= START And cnt - START < NUM Then
      Print #1, arr(i, 2) & ";" & arr(i, 3)
    End If
    If arr(i, 1) <> arr(i + 1, 1) Then
      Close #1: cnt = 0
      If Len(arr(i + 1, 1)) Then Open ThisWorkbook.Path & "\" & arr(i + 1, 1) & ".txt" For Output As #1
    End If
  Next
End Sub

寻梦的谷

一把小刀闯天下 发表于 2019-3-15 17:52
Option Explicit

Const START = 4 '开始行

收到了，我测试了一下
第一个代码和前面的代码一样
第二个代码有错误，跑出来的结果全是1kb，数据不全

其实我用你第一次发的代码吧，剩下的一个个改也用不了多少时间，真的很麻烦你了，谢谢！

寻梦的谷

我总结一下：
第一个代码是选取特定行，提取选中行的某两列进行提取数据，并导出为txt格式，采用逗号分割，并预留了txt的前四行自行设置内容，从txt的第5行开始录入数据
第二个代码：
根据当前表格中第一列数据的不同，将第一列数据相同的行的第三、四列提取出来。并按照第一列的不同对txt进行不同的命名。采用分好；分割。

后面的两个代码，可参见我对层主的回复。
最后感谢楼上两位对我的帮助~
此贴终结，希望能帮助到后面和我遇到一样困难的人；
祝好！

一把小刀闯天下

'好好看了一下，原来是每个输出文件都可以有个自定义的文件头，，，

Option Explicit

Sub test()
  Dim arr, i, head
  head = Split("aaa,bbb,ccc,ddd", ",") '4行，内容自己修改，由逗号确定具体行数，，，
  arr = [a1].CurrentRegion.Offset(1)
  Open ThisWorkbook.Path & "\" & arr(1, 1) & ".txt" For Output As #1
  Print #1, Join(head, vbNewLine)
  For i = 1 To UBound(arr, 1) - 1
    Print #1, arr(i, 2) & ";" & arr(i, 3)
    If arr(i, 1) <> arr(i + 1, 1) Then
      Close #1
      If Len(arr(i + 1, 1)) Then
        Open ThisWorkbook.Path & "\" & arr(i + 1, 1) & ".txt" For Output As #1
        Print #1, Join(head, vbNewLine)
      End If
    End If
  Next
End Sub