Sub 导数据()   
    With Application.FileDialog(msoFileDialogFilePicker)   
        .InitialFileName = ThisWorkbook.Path   
        .Title = "请选择一个或多个文件"   
        If .Show Then Set fs = .SelectedItems Else Exit Sub   
    End With   
    For Each f In fs   
        Open f For Input As #1   
        s = s & Input(LOF(1), 1)   
        Close #1   
    Next   
    Set regx = CreateObject("vbscript.regexp")   
    regx.Pattern = "^\s*\d.+[\r\n]+.*"   
    regx.Global = True: regx.MultiLine = True   
    Set mh = regx.Execute(s)   
    If mh.Count = 0 Then MsgBox "文本格式不符!": Exit Sub   
    ReDim arr(1 To mh.Count, 1 To 10)
    regx.Pattern = "([+-]\s*)?\S+"   
     For i = 0 To mh.Count - 1   
        Set mh1 = regx.Execute(Application.Clean(Replace(mh(i), "Skip", "")))   
        For j = 0 To mh1.Count - 1   
            arr(i + 1, j + 1) = mh1(j)   
        Next   
    Next   
这个程序是能够导入dat到EXCEL,但是唯一不足的是：data文件10行导入到EXCEL是5行，源程序看不太懂，有没有大师修改下呢？

上述拷贝有点遗漏，全部程序如下
Sub 导数据()   
    With Application.FileDialog(msoFileDialogFilePicker)   
        .InitialFileName = ThisWorkbook.Path   
        .Title = "请选择一个或多个文件"   
        If .Show Then Set fs = .SelectedItems Else Exit Sub   
    End With   
    For Each f In fs   
        Open f For Input As #1   
        s = s & Input(LOF(1), 1)   
        Close #1   
    Next   
    Set regx = CreateObject("vbscript.regexp")   
    regx.Pattern = "^\s*\d.+[\r\n]+.*"   
    regx.Global = True: regx.MultiLine = True   
    Set mh = regx.Execute(s)   
    If mh.Count = 0 Then MsgBox "文本格式不符!": Exit Sub   
    ReDim arr(1 To mh.Count, 1 To 10) '定义一个数组arr，,行数为1到mh.Count，列数为1到5   
    regx.Pattern = "([+-]\s*)?\S+"   
     For i = 0 To mh.Count - 1   
        Set mh1 = regx.Execute(Application.Clean(Replace(mh(i), "Skip", "")))   
        For j = 0 To mh1.Count - 1   
            arr(i + 1, j + 1) = mh1(j)   
        Next   
    Next   
   
    Range("a1").CurrentRegion.Offset(1) = ""   
    Range("a2").Resize(UBound(arr), 10) = arr   
End Sub   

dat文件数据如下：
1     0           0.000       0.000       0.000      
2     100         57.530      0.000       0.000      
3     200         55.805      0.000       0.000      
4     300         55.363      0.000       0.000      
5     400         55.424      0.000       0.000      
6     500         54.373      0.000       0.000      
7     600         53.367      0.000       0.000      
8     700         55.646      0.000       0.000      
9     800         56.656      0.000       0.000      
10    900         56.842      0.000       0.000     
我想要导入后EXCEL后是10行5列

    Dim k, n As Integer
    k = 1
     For i = 0 To mh.Count - 1
            n = 1
            Set mh1 = regx.Execute(Application.Clean(Replace(mh(i), "Skip", "")))
            For j = 0 To mh1.Count - 1
                    If j = 5 Then
                        k = k + 1
                        n = 1
                    End If
                    arr(k, n) = mh1(j)
                    n = n + 1
            Next
            k = k + 1
    Next

后面的循环这样补充你看看