[已解决]大灰狼老师并各位高手好

1225426230

两次问的都是转存文本的问题，感谢大灰狼老师在百忙之中给与解答。
上次问的多单元格转存文本，老师给的代码这两天始终在研究消化，但还是有一个事情没解决，没办法还得麻烦大灰狼老师或者其他高手前辈，就是我转存后的文件名，能不能是从bk2开始第二行各单元格内容做为文件名，而不是bk2、bl2......为文件名。大灰狼老师给的代码其他的都不要动，还是自适应列数。先行致谢！大灰狼老师给的代码如下：

• Sub aaa()
• Dim s$, i&, r&, j&, arr, fd$
• arr = [bk2].CurrentRegion
• fd = "e:\ST"
• If Dir(fd, vbDirectory) = "" Then MkDir fd
• For j = 1 To UBound(arr, 2)
•   s = fd & "\" & Split(Columns(j + 62).Address(0, 0), ":")(0) & "2.txt"
•   i = FreeFile
•   Open s For Output As #i
•   For r = 2 To UBound(arr)
•     Print #i, arr(r, j)
•   Next r
•   Close #i
• Next j
• End Sub
  

[color=rgb(51, 102, 153) !important]复制代码

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-9-28 16:18

没测试，你自己试试吧。

1. Sub aaa()
   
2. If ActiveSheet.Name <> "车间一" Then Exit Sub
   
3. Dim s$, i&, r&, j&, arr, fd$
   
4. arr = [bk2].CurrentRegion'把单元格数据放到二维数组arr里
   
5. fd = "e:\ST"  '保存路径
   
6. If Dir(fd, vbDirectory) = "" Then MkDir fd  '如果没有ST那个文件夹，则新建ST文件夹
   
7. For j = 1 To UBound(arr, 2)
   
8.   s = fd & "" & arr(1, j) & ".txt" '文件名取数组第一行数据
   
9.   i = FreeFile
   
10.   Open s For Output As #i
    
11.   For r = 2 To UBound(arr)
    
12.     Print #i, arr(r, j)
    
13.   Next r
    
14.   Close #i
    
15. Next j
    
16. End Sub

复制代码

跳转到最佳答案楼层

苏子龙

Sub aaa()
Dim s$, i&, r&, j&, arr, fd$
arr = [bk2].CurrentRegion'把单元格数据放到二维数组arr里
fd = "e:\ST"  '保存路径
If Dir(fd, vbDirectory) = "" Then MkDir fd  '如果没有ST那个文件夹，则新建ST文件夹
For j = 1 To UBound(arr, 2)
  s = fd & "\" & Split(Columns(j + 62).Address(0, 0), ":")(0) & "2.txt"'改这里就好了，自己看arr里面数据
  i = FreeFile
  Open s For Output As #i
  For r = 2 To UBound(arr)
    Print #i, arr(r, j)
  Next r
  Close #i
Next j
End Sub

大灰狼1976

原来我是理解错了，我还特意取了列号，其实这么简单！

1225426230

具体怎么改呢？我是个新手，麻烦帮改好

1225426230

大灰狼老师我的工作表名是车间一，限定宏只在这个工作表运行，而不是整个工作簿，那么是不是限定语句：If ActiveSheet.Name <> "sheet2" Then exit sub，要把sheet2换成车间一呢？

大灰狼1976

没测试，你自己试试吧。

1. Sub aaa()
   
2. If ActiveSheet.Name <> "车间一" Then Exit Sub
   
3. Dim s$, i&, r&, j&, arr, fd$
   
4. arr = [bk2].CurrentRegion'把单元格数据放到二维数组arr里
   
5. fd = "e:\ST"  '保存路径
   
6. If Dir(fd, vbDirectory) = "" Then MkDir fd  '如果没有ST那个文件夹，则新建ST文件夹
   
7. For j = 1 To UBound(arr, 2)
   
8.   s = fd & "" & arr(1, j) & ".txt" '文件名取数组第一行数据
   
9.   i = FreeFile
   
10.   Open s For Output As #i
    
11.   For r = 2 To UBound(arr)
    
12.     Print #i, arr(r, j)
    
13.   Next r
    
14.   Close #i
    
15. Next j
    
16. End Sub

复制代码

1225426230

谢谢大灰狼老师

1225426230

测试完全符合要求，再一次表示感谢