[已解决]若干VBA如何合并成一个

lijian8003

下列VBA是将txt数据导入excel，共有1330个，如何用 For y = 1 To 1330 合并成一个？

Sub 导入1()
Sheets("1").Select
Application.DisplayAlerts = False
Dim s() As String
Dim s2() As String
On Error Resume Next
Range("b1:az210").ClearContents
Open "d:\数据\lishi\0001.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("b" & x + 1).Resize(, ss + 1) = s2
   Next
Application.DisplayAlerts = True
End Sub

Sub 导入2()
Sheets("2").Select
Application.DisplayAlerts = False
Dim s() As String
Dim s2() As String
On Error Resume Next
Range("b1:az210").ClearContents
Open "d:\数据\lishi\0002.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("b" & x + 1).Resize(, ss + 1) = s2
   Next
Application.DisplayAlerts = True
End Sub

......

Sub 导入1330()
Sheets("1330").Select
Application.DisplayAlerts = False
Dim s() As String
Dim s2() As String
On Error Resume Next
Range("b1:az210").ClearContents
Open "d:\数据\lishi\1330.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("b" & x + 1).Resize(, ss + 1) = s2
   Next
Application.DisplayAlerts = True
End Sub

最佳答案

月排行榜 / 总排行榜

爱疯

2015-10-2 15:46

Sub test1()
    Dim i
    For i = 1 To 1330
        Call test2(i)
    Next i
End Sub

Sub test2(x)
    Sheets(CStr(i)).Select
    Application.DisplayAlerts = False
    Dim s() As String
    Dim s2() As String
    On Error Resume Next
    Range("b1:az210").ClearContents
    Open "d:\数据\lishi\" & Format(i, "0000") & ".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("b" & x + 1).Resize(, ss + 1) = s2
    Next
    Application.DisplayAlerts = True
End Sub

跳转到最佳答案楼层

爱疯

Sub test1()
    Dim i
    For i = 1 To 1330
        Call test2(i)
    Next i
End Sub

Sub test2(x)
    Sheets(CStr(i)).Select
    Application.DisplayAlerts = False
    Dim s() As String
    Dim s2() As String
    On Error Resume Next
    Range("b1:az210").ClearContents
    Open "d:\数据\lishi\" & Format(i, "0000") & ".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("b" & x + 1).Resize(, ss + 1) = s2
    Next
    Application.DisplayAlerts = True
End Sub