[已解决]不太会描述，是关于循环或者变量的问题，老师们帮我看看

wboy · 发表于 2011-12-29 13:58

Sub Macro1()
Sheets("z").Select
Columns("a:a").Select
Selection.Copy
Sheets("00").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
  ActiveWorkbook.SaveAs Filename:="C:\00.txt", FileFormat:=xlUnicodeText, CreateBackup:=False
  Sheets("z").Select
Columns("b:b").Select
Selection.Copy
Sheets("01").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues
  ActiveWorkbook.SaveAs Filename:="C:\01.txt", FileFormat:=xlUnicodeText, CreateBackup:=False
End Sub
这段代码中改变颜色的地方是我希望采用变量的地方。
附件中工作表z其实有很多列，工作簿也是有很多工作表的，一小段一小段增加代码很麻烦，请老师们费心帮一下。

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2011-12-29 15:52

Sub aa()
Application.ScreenUpdating = False
Dim sht As Worksheet, i As Long, n As Long
Dim arr
With Sheets("z")
n = .Range("IV1").End(xlToLeft).Column
For i = 1 To n
Set sht = Sheets.Add
sht.Name = .Cells(1, i)
arr = .Range(.Cells(1, i), .Cells(.Cells(65536, i).End(xlUp).Row, i))
Sheets(sht.Name).Range("A1").Resize(UBound(arr), 1) = arr
ActiveWorkbook.SaveAs Filename:="C:" & sht.Name & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=False
Next i
End With
Application.ScreenUpdating = True
End Sub

复制代码

跳转到最佳答案楼层

sunjing-zxl · 发表于 2011-12-29 15:52

这个最佳答案由 sunjing-zxl 给出，感谢 sunjing-zxl 的回答。

单击隐藏图章

Sub aa()
Application.ScreenUpdating = False
Dim sht As Worksheet, i As Long, n As Long
Dim arr
With Sheets("z")
n = .Range("IV1").End(xlToLeft).Column
For i = 1 To n
Set sht = Sheets.Add
sht.Name = .Cells(1, i)
arr = .Range(.Cells(1, i), .Cells(.Cells(65536, i).End(xlUp).Row, i))
Sheets(sht.Name).Range("A1").Resize(UBound(arr), 1) = arr
ActiveWorkbook.SaveAs Filename:="C:" & sht.Name & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=False
Next i
End With
Application.ScreenUpdating = True
End Sub

复制代码

吕?布 · 发表于 2011-12-29 16:09

试试
Sub Demo()
Dim i As Long
Dim wb As Workbook
Set wb = ActiveWorkbook
For i = 1 To 2  ' 处理第1(A)列到第2(B)列
      Call SaveAsTxt(wb, "z", i)
Next
End Sub

Function SaveAsTxt(wb As Workbook, DataSheetName As String, Col As Long)
Dim sSheetName As String
Dim shtSave As Worksheet
With wb
      .Sheets(DataSheetName).Columns(Col).Copy
      sSheetName = Format(Col - 1, "00")
      Set shtSave = .Sheets(sSheetName)
      With shtSave
         .Range("A1").PasteSpecial Paste:=xlPasteValues
         .SaveAs Filename:="C:\" & sheetname & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=False
      End With
End With
End Functio

wboy · 发表于 2011-12-29 16:27

老师，您太厉害了，我本来就是想这样命名文件名称的,但是没看出规律，索性才随便命名的。谢谢，谢谢！
还想问一下，这样得到的文本文件在手机上为什么只能正确显示出文件名，内容有的是看不到，有的是乱码，能不能想办法修改一下编码的格式？

wboy · 发表于 2011-12-29 16:46

3楼吕布版主，您的代码提示错误1004，方法'saveas'作用于对象'_wooksheet'时失败
点击调试的时候.SaveAs Filename:="C:\" & sheetname & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=False，这行代码是黄色，您能看一下怎么修改吗？

吕?布 · 发表于 2011-12-29 16:55

没调试，有个变量写错了
Option Explicit

Sub Demo()
Dim i As Long
Dim wb As Workbook
Set wb = ActiveWorkbook
For i = 2 To 3 ' 处理第1(A)列到第2(B)列
      Call SaveAsTxt(wb, "z", i)
Next
End Sub

Function SaveAsTxt(wb As Workbook, DataSheetName As String, Col As Long)
Dim sSheetName As String
Dim shtSave As Worksheet
With wb
      .Sheets(DataSheetName).Columns(Col).Copy
      sSheetName = Format(Col - 1, "00")
      Set shtSave = .Sheets(sSheetName)
      With shtSave
         .Range("A1").PasteSpecial Paste:=xlPasteValues
         .SaveAs Filename:="C:\" & sSheetName & ".txt", FileFormat:=xlUnicodeText, CreateBackup:=False
      End With
End With
End Function

sunjing-zxl · 发表于 2011-12-29 17:02

wboy 发表于 2011-12-29 16:27
老师，您太厉害了，我本来就是想这样命名文件名称的,但是没看出规律，索性才随便命名的。谢谢，谢谢！
还想 ...

我没用手机看这些东西，搞不懂手机支持什么格式了

wboy · 发表于 2011-12-29 17:40

修改以后的代码可以了，再次感谢两位。

		自动登录	找回密码
密码			注册