[已解决]如何将多个宏代码合而为一

lijian8003

有下述210个宏代码，从\文件1\里分别将001.txt  002.txt...210.txt导入001 002 ...210工作表的A列，如何将这210个宏代码合写在一起？
Sub 导入001()
Sheets("001").Select
Range("A1:A100").ClearContents
Application.DisplayAlerts = False '关闭报警
Dim s() As String '定义字串数组
Dim s2() As String '定义字串数组
On Error Resume Next
'Range("a1", Cells.Find("*", , , , , xlPrevious)) = ""
Open ThisWorkbook.Path & "\文件1\001.txt" For Input As #1 '打开文本文件
s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf) 'InputB(LOF(1), 1)读入内存，StrConv 编码转换；Split(）分割成行
Close #1 '关闭文件
      For x = 0 To UBound(s)
         s2 = Split(s(x), " ")
         ss = UBound(s2)
       Range("a" & x + 1).Resize(, ss + 1).NumberFormat = "@"
       Range("a" & x + 1).Resize(, ss + 1) = s2
   Next
Application.DisplayAlerts = True '打开报警
End Sub

Sub 导入002()
Sheets("002").Select
Range("A1:A100").ClearContents
Application.DisplayAlerts = False '关闭报警
Dim s() As String '定义字串数组
Dim s2() As String '定义字串数组
On Error Resume Next
'Range("a1", Cells.Find("*", , , , , xlPrevious)) = ""
Open ThisWorkbook.Path & "\文件1\002.txt" For Input As #1 '打开文本文件
s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf) 'InputB(LOF(1), 1)读入内存，StrConv 编码转换；Split(）分割成行
Close #1 '关闭文件
      For x = 0 To UBound(s)
         s2 = Split(s(x), " ")
         ss = UBound(s2)
       Range("a" & x + 1).Resize(, ss + 1).NumberFormat = "@"
       Range("a" & x + 1).Resize(, ss + 1) = s2
   Next
Application.DisplayAlerts = True '打开报警
End Sub

...

Sub 导入210()
Sheets("210").Select
Range("A1:A100").ClearContents
Application.DisplayAlerts = False '关闭报警
Dim s() As String '定义字串数组
Dim s2() As String '定义字串数组
On Error Resume Next
'Range("a1", Cells.Find("*", , , , , xlPrevious)) = ""
Open ThisWorkbook.Path & "\文件1\210.txt" For Input As #1 '打开文本文件
s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf) 'InputB(LOF(1), 1)读入内存，StrConv 编码转换；Split(）分割成行
Close #1 '关闭文件
      For x = 0 To UBound(s)
         s2 = Split(s(x), " ")
         ss = UBound(s2)
       Range("a" & x + 1).Resize(, ss + 1).NumberFormat = "@"
       Range("a" & x + 1).Resize(, ss + 1) = s2
   Next
Application.DisplayAlerts = True '打开报警
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2014-6-28 16:31

又提新要求啦！
Sub 导入()
    For I = 1 To 210
        SHNam = Format(I, "000")
        With Sheets(SHNam)
            .Range("A1:G100").ClearContents
            Application.DisplayAlerts = False
            Dim s() As String
            Dim s2() As String
            On Error Resume Next
            Open ThisWorkbook.Path & "\文件1\" & SHNam & ".txt" For Input As #1
            s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
            Close #1
            For x = 0 To UBound(s)
                s2 = Split(s(x), " ")
                ss = UBound(s2)
                .Range("a" & x + 1).Resize(, ss + 1).NumberFormat = "@"
                .Range("a" & x + 1).Resize(, ss + 1) = s2
            Next
        End With
    Next
    Application.DisplayAlerts = True
End Sub

跳转到最佳答案楼层

ghostjiao

1. Sub 导入()
   
2.     Application.DisplayAlerts = False    '关闭报警
   
3.     For i = 1 To 210
   
4.         Sheets(Format(i, "000")).Select
   
5.         Range("A1:A100").ClearContents
   
6.         Dim s() As String    '定义字串数组
   
7.         Dim s2() As String    '定义字串数组
   
8.         On Error Resume Next
   
9.         'Range("a1", Cells.Find("*", , , , , xlPrevious)) = ""
   
10.         Open ThisWorkbook.Path & "\文件1" & Format(i, "000") & " .txt" For Input As #1    '打开文本文件
    
11.         s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)    'InputB(LOF(1), 1)读入内存，StrConv 编码转换；Split(）分割成行
    
12.         Close #1    '关闭文件
    
13.         For x = 0 To UBound(s)
    
14.             s2 = Split(s(x), " ")
    
15.             ss = UBound(s2)
    
16.             Range("a" & x + 1).Resize(, ss + 1).NumberFormat = "@"
    
17.             Range("a" & x + 1).Resize(, ss + 1) = s2
    
18.         Next
    
19.     Next
    
20.     Application.DisplayAlerts = True    '打开报警
    
21. End Sub

复制代码

是不是这样就行了，当然首先要保证有这么多工作表，且工作表的名字能对上

zjdh

又提新要求啦！
Sub 导入()
    For I = 1 To 210
        SHNam = Format(I, "000")
        With Sheets(SHNam)
            .Range("A1:G100").ClearContents
            Application.DisplayAlerts = False
            Dim s() As String
            Dim s2() As String
            On Error Resume Next
            Open ThisWorkbook.Path & "\文件1\" & SHNam & ".txt" For Input As #1
            s = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
            Close #1
            For x = 0 To UBound(s)
                s2 = Split(s(x), " ")
                ss = UBound(s2)
                .Range("a" & x + 1).Resize(, ss + 1).NumberFormat = "@"
                .Range("a" & x + 1).Resize(, ss + 1) = s2
            Next
        End With
    Next
    Application.DisplayAlerts = True
End Sub

lijian8003

zjdh 发表于 2014-6-28 16:31
又提新要求啦！
Sub 导入()
    For I = 1 To 210

感谢帮助。您的代码经过测试，有误。烦请查看。----发现问题所在了，是 Range("A1:G100").ClearContents

lijian8003

ghostjiao 发表于 2014-6-28 16:27
是不是这样就行了，当然首先要保证有这么多工作表，且工作表的名字能对上

感谢帮助。您的代码经过测试，有误。烦请查看。------3#代码测试通过

lijian8003

zjdh 发表于 2014-6-28 16:31
又提新要求啦！
Sub 导入()
    For I = 1 To 210

原想依样画葫芦，不料却画不成，以下的代码也是001-210有210个，也想合并为一个宏代码，就是搞不妥。烦请帮助！
Sub 导出001()
Dim i&, j%, k, s, arr
     arr = Sheets("001").UsedRange
     Open ThisWorkbook.Path & "\文件2\" & "001.txt" For Output As #1
         For i = 1 To 3
             s = ""
             For j = 7 To 7 '假设数据区域有多列
                s = s & vbTab & arr(i, j)
             Next
             Print #1, Mid(s, 2)
         Next
     Close #1
End Sub

zjdh

lijian8003 发表于 2014-6-28 17:11
感谢帮助。您的代码经过测试，有误。烦请查看。----发现问题所在了，是 Range("A1:G100").ClearContent ...

那是特意修改的，因为你的原始数据要占好多列，而你原来语句只清除A列，感觉不合理。

lijian8003

zjdh 发表于 2014-6-28 18:10
那是特意修改的，因为你的原始数据要占好多列，而你原来语句只清除A列，感觉不合理。

原想依样画葫芦，不料却画不成，6#的宏代码也是001-210有210个，也想合并为一个宏代码，就是搞不妥。烦请帮助！

zjdh

lijian8003 发表于 2014-6-28 17:50
原想依样画葫芦，不料却画不成，以下的代码也是001-210有210个，也想合并为一个宏代码，就是搞不妥。烦 ...

你这是要导出数据到TXT，最好上传一个附件。
看代码似乎只要导出第7列数据，不知是否这样？

lijian8003

zjdh 发表于 2014-6-28 18:17
你这是要导出数据到TXT，最好上传一个附件。
看代码似乎只要导出第7列数据，不知是否这样？

是的。放上附件