[已解决]按A列在文件同目录下生成txt文件，并将b和c两列合并写入txt。

yang2739

如题：按地市在同目录下生成txt文件，并将b和c两列合并写入txt。





A                B                             C

西安	A	2
西安	A	3
西安	A	4
西安	A	5
渭南	E	1
渭南	E	2
渭南	E	3
渭南	E	4
咸阳	X	1
咸阳	X	2
咸阳	X	3
咸阳	X	4
西安	A	1
渭南	E	7

最佳答案

月排行榜 / 总排行榜

爱疯

2016-5-13 21:13

举例2.rar (27.38 KB, 下载次数: 10)

2016-5-13 21:13 上传

点击文件名下载附件


确实是我忘了给s清零，谢谢提醒！

跳转到最佳答案楼层

爱疯

Sub Click()
    Dim A, B(), i, s, p$
    p = ThisWorkbook.Path & "\"
    Range("a1").CurrentRegion.Sort key1:=[a1], order1:=xlAscending, _
                                   key2:=[b1], order2:=xlAscending, _
                                   key3:=[c1], order3:=xlAscending, _
                                   Header:=xlNo

    A = Range("a1").CurrentRegion
    For i = 1 To UBound(A)
        s = s + 1
        ReDim Preserve B(1 To s)
        B(s) = A(i, 2) & A(i, 3)

        If i = UBound(A) Then
            Call writeText(B, p, A(i, 1)): Erase B
        ElseIf A(i, 1) <> A(i + 1, 1) Then
            Call writeText(B, p, A(i, 1)): Erase B
        End If
    Next i
End Sub

Sub writeText(B, p, f)
    Dim i
    Open p & f & ".txt" For Output As #1
    For i = 1 To UBound(B)
       Print #1, B(i)
    Next i
    Close #1
End Sub


举例.rar (27.29 KB, 下载次数: 6)

2016-5-13 17:34 上传

点击文件名下载附件

yang2739

爱疯 发表于 2016-5-13 17:35
Sub Click()
    Dim A, B(), i, s, p$
    p = ThisWorkbook.Path & "\"

你的稍微有些问题，排在前面的生成的TXT是从第一行写起，后边的都不是。能改改吗？

爱疯

能举例说下，哪个地方错了，应该是什么吗？

爱疯

举例2.rar (27.38 KB, 下载次数: 10)

2016-5-13 21:13 上传

点击文件名下载附件


确实是我忘了给s清零，谢谢提醒！

yang2739

爱疯 发表于 2016-5-13 21:13
确实是我忘了给s清零，谢谢提醒！

还是版主牛