apang

再把 CreateObject("Wscript.Shell")  这一行改成下面两行
strOut = "" : n = ""
Next

apang

哦，貌似错了
strOut = "" : n = 0
Next
试试

apang

是这个帖子吧？http://www.bathome.net/viewthread.php?tid=23404&highlight=
1.txt~300.txt列数必须相同，行数可以不相同。

Set fso = CreateObject("Scripting.FileSystemObject")
m = 2  'm=总列数
For x = 1 to 300
    Set file = fso.OpenTextFile(x & ".txt")
    fso.OpenTextFile("z" & x & ".txt",2,true).Write GetStr(file)
    file.Close : Set file = Nothing
Next

Function GetStr(file)
    ReDim arIn(m-1) : ReDim arOut(m-1)
    Max = 0 : n = 0
    Do Until file.AtEndOfStream
        strLine = RegEx(file.ReadLine)
        If strLine <> "" Then
            ReDim PreServe ar(m-1,n)
            For i = 0 to m-1
                arIn(i) = arIn(i) & "$" & Split(strLine)(i) & " "
                ar(i,n) = arIn(i)
            Next
            n = n + 1
       End If
    Loop

    For i = 0 to m-1
        For j = CLng(n/2) to 0 step -1
            ar1 = Split(ar(i,n-1),ar(i,j))
            If UBound(ar1) > 1 Then
                For k = 1 to UBound(ar1) - 1
                    a = UBound(Split(ar1(k))) - 1
                    b = UBound(Split(ar(i,j))) - 1
                    If a >= 0 Then
                        arOut(i) = arOut(i)&Mid(Split(ar1(k))(a),2)&" "
                    Else
                        arOut(i) = arOut(i)&Mid(Split(ar(i,j))(b),2)&" "
                    End If
                Next
                Exit For
            End If
        Next
        If UBound(Split(arOut(i))) > Max Then Max = UBound(Split(arOut(i)))
    Next

    For i = 0 to Max - 1
        For j = 0 to m-1
            If UBound(Split(arOut(j))) >= i Then
                strOut = strOut & Split(arOut(j))(i) & vbTab
            Else strOut = strOut & vbTab
            End If
        Next
        strOut = Left(strOut,Len(strOut)-1) & vbCrLf
    Next

    GetStr = strOut  
End Function

Function RegEx(strLine)
   Set re = New RegExp
   re.Pattern = "\s+"
   re.Global = True
   RegEx = Trim(re.Replace(strLine," "))
End Function
复制代码