求助大神们解决下批量将表格内容导出生成TXT文件

学生会2013

工作中遇到的问题，我想将A1列工作表区域输入工作表名称后，在按照选择区域，将工作表内容批量生成TXT文件，生成TXT文件名称按照C列对应，并保存在当下execl文件目录下。


这是我工作遇到的问题，由于我对于生成文件部分实在太弱了，想了好多天一直没能解决，也查了好多资料总是弄不好，请大神们帮忙看看，请指导一下，我会继续努力学习的。感谢大神们帮忙解决下。谢谢各位大哥大姐了。

lss001

导出TXT文件.rar (21.96 KB, 下载次数: 13)

2024-10-13 09:27 上传

点击文件名下载附件

请参考附件

ykcbf1100

附件供参考。。。

身份证号列必须用文本，不然，写入TXT的身份证号会不正确。

ykcbf1100

分表中的身份证号列必须用文本。

ykcbf1100

。。。。。。。。。。。。。。。。

songshihai

1. Sub 导出TXT文件()
   
2.     路径 = ThisWorkbook.Path & ""
   
3.     For i = 2 To Cells(Rows.Count, 3).End(xlUp).Row
   
4.         Open 路径 & Cells(i, 3) & ".txt" For Output As #1
   
5.         'output(覆盖，已有同名文件就替换掉，没有就新建)
   
6.         'append(追加。如果有同名文件就保留数据并追加写入，没有就新建)
   
7.         arr = Sheets(Cells(i, 1).Value).Range(Replace(Cells(i, 2).Value, "：", ":"))
   
8.         For a = 1 To UBound(arr)
   
9.             x = ""
   
10.             For b = 1 To UBound(arr, 2)
    
11.                 x = x & arr(a, b) & vbTab '连接每一行数据
    
12.             Next b
    
13.             Print #1, Left(x, Len(x) - 1) '写入
    
14.         Next a
    
15.         Close #1 '处理完一定要关掉
    
16.     Next i
    
17. End Sub
    
18. 
    

复制代码

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, br, i&, k&, r&, strPath$, strFileName$, strTxt$
   
    Application.ScreenUpdating = False
   
    ar = Worksheets(1).[A1].CurrentRegion.Value
    strPath = ThisWorkbook.Path & "\"
    For i = 2 To UBound(ar)
        strFileName = strPath & ar(i, 1) & ".txt"
        br = Worksheets(ar(i, 1)).Range(ar(i, 2)).Value
        strTxt = ""
        For k = 1 To UBound(br)
            If k = 1 Then
                strTxt = Join(Application.Index(br, k), vbTab)
            Else
                strTxt = strTxt & vbCrLf & Join(Application.Index(br, k), vbTab)
            End If
        Next k
        Open strFileName For Output As #1
            Print #1, strTxt
        Close #1
    Next i
        
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

ykcbf1100

。。。。。。。。。。

ykcbf1100

。。。。。。。。。。。