[發問] 如從 TXT 檔案選取要的資料到 EXCEL 來

metrostar

學妹又來麻煩大家了

打開 EXCEL 檔有詳細說明喔

請帥哥/美女版主 帥哥/美女學長跟學姐

幫忙學妹完成



謝謝了

lichang

小弟我正好也需要此資料，來研習一下!!

cji3cj6xu6

請問超級板主，
Dim fs, ar, fn$, br(1 To 10000, 1 To 7), t
Dim c, i&, j&, r&, ph$

裡面的 fn$ 與 j& 是定義為？？

Thanks,

metrostar

回復 4# Hsieh


太棒了,可以執行了
多謝超級帥哥版主
學妹非常感動呢
您真是太強太強了
感謝您並祝賀您
幸福好運永遠降臨您身上

Hsieh

回復 3# metrostar

1. Sub test()
   
2.     Dim fs, ar, fn$, br(1 To 10000, 1 To 7), t
   
3.     Dim c, i&, j&, r&, ph$
   
4.     ph = ThisWorkbook.Path & "\" '檔案目錄
   
5.     c = Array(0, 0, 1, 2, 3, 4, 5, 7)
   
6.        fs = Application.GetOpenFilename("Text Files (*.txt), *.txt", , , , True)
   
7.         If Not IsArray(fs) Then MsgBox "沒有選取檔案 !!!": Exit Sub
   
8.     With CreateObject("vbscript.regexp")
   
9.         .Global = True
   
10.         .Pattern = " +(?!$)"
    
11.         s = LBound(fs)
    
12.        While s <= UBound(fs)
    
13.             Open fs(s) For Input As #1
    
14.             ar = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
    
15.             Reset
    
16.             For i = 4 To UBound(ar) - 1
    
17.                 r = r + 1
    
18.                 ar(i) = .Replace(ar(i), "|")
    
19.                 t = Split(ar(i), "|")
    
20.                 For j = 1 To UBound(c)
    
21.                     br(r, j) = t(c(j))
    
22.                 Next
    
23.                 br(r, 2) = Mid(Replace(fs(s), ph, ""), 6, 8)
    
24.             Next
    
25.             Close #1
    
26.             s = s + 1
    
27.         Wend
    
28.     End With
    
29.     With Sheets("Sheet2")
    
30.         .Range("2:" & Rows.Count).ClearContents
    
31.         .Range("a:a").NumberFormatLocal = "@"
    
32.         If r > 0 Then .[a2].Resize(r, UBound(br, 2)) = br
    
33.     End With
    
34. End Sub

複製代碼

metrostar

Sub test()
    Dim fs$, ar, fn$, br(1 To 10000, 1 To 7), t
    Dim c, i&, j&, r&, ph$
    c = Array(0, 0, 1, 2, 3, 4, 5, 7)
        With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = "*.txt"
        .Show
        If .SelectedItems.Count > 0 Then
            fs = .SelectedItems(1)
        Else
            MsgBox "沒有選取檔案 !!!"
            Exit Sub
        End If
    End With
    With CreateObject("vbscript.regexp")
        .Global = True
        .Pattern = " +(?!$)"
        While Len(fn) > 0
            Open ph & fn For Input As #1
            ar = Split(StrConv(InputB(LOF(1), 1), vbUnicode), vbCrLf)
            Reset
            For i = 4 To UBound(ar) - 1
                r = r + 1
                ar(i) = .Replace(ar(i), "|")
                t = Split(ar(i), "|")
                For j = 1 To UBound(c)
                    br(r, j) = t(c(j))
                Next
                br(r, 2) = Mid(fn, 6, 8)
            Next
            fn = Dir
        Wend
    End With
    With Sheet1
        .Range("2:" & Rows.Count).ClearContents
        .Range("a:a").NumberFormatLocal = "@"
        .[a2].Resize(r, UBound(br, 2)) = br
    End With
End Sub

這些程式碼是位EXCELHOME 帥哥學長幫忙的,但是學妹這裡不能使用
會出現這行錯誤   .[a2].Resize(r, UBound(br, 2)) = br
請 帥哥/美女版主 帥哥/美女學長跟學姐
幫忙學妹修改一下下 ? 謝謝啦

metrostar

拜託
有請 帥哥/美女版主 帥哥/美女學長跟學姐
能幫忙學妹完成 ? 謝謝