返回列表 上一主題 發帖

[發問] VBA TXT 依照段落開啟需求

Sub TEST()
Dim xPath$, xF$, xS As Worksheet, xEnd As Range, xR As Range, TT, T, N$, C%
xPath = ThisWorkbook.Path & "\"
Set xS = ThisWorkbook.Sheets("工作表1")
Do
 If xF = "" Then xF = Dir(xPath & "*.txt") Else xF = Dir
 If xF = "" Then Exit Do
 If Not xS.[A:A].Find(xF, LookAT:=xlWhole) Is Nothing Then GoTo 101
 Set xEnd = xS.Cells(Rows.Count, 1).End(xlUp)(2)
 If xEnd.Row < 3 Then Set xEnd = xS.[A3]
 xEnd = xF
 
 Open xPath & xF For Input Access Read As #1
 Do Until EOF(1)
  Line Input #1, T
  N = Switch(T = "&", "B", T = "%", "M", T = "$", "AC", T = T, "")
  '_T="&",取B欄,類推∼∼;找不到"&%$",N為空值 
  If N <> "" Then Set xR = xEnd(1, N):  C = 0
  '_找到"&%$"後,以xR定位為各分類的首格
  For Each TT In Split(T, " ")
    C = C + 1:  xR(1, C) = TT
  Next
 Loop
 Close #1
101: Loop
End Sub
 
 
大致如上,其他細節請自行更改或調整∼∼

TOP

本帖最後由 准提部林 於 2015-10-28 11:25 編輯

N = Switch(T = "&", "B", T = "%", "M", T = "$", "AC", T = T, "")
也可用:
N = Array("", "", "B", "M", "AC")(InStr("_&%$", T))
_InStr 值只有0,1,2,3,4 五種結果 

"_&%$" 前面加"_",是為防止T是空格時的誤判(與FIND函數一樣,結果為1)
可測試 MsgBox InStr("&%$", "")

Array 前面兩個空字符,即是在T為空值(InStr值為1)或找不到文字時(InStr值為0),以空字符顯示

TOP

回復 4# Jason80Lo

If Not xS.[A:A].Find(xF, LookAT:=xlWhole) Is Nothing Then GoTo 101
_如果文字檔名稱已存在,略過 

Set xEnd = xS.Cells(Rows.Count, 1).End(xlUp)(2)
_取得準備填入資料的位置(最後一筆資料的下一格空白格) 

If xEnd.Row < 3 Then Set xEnd = xS.[A3]
_如果這空白格列號小于3,則取A3(防止標題無文字的錯誤) 

xEnd = xF
_第一格填文字檔名 

For Each TT In Split(T, " ")
  C = C + 1:  xR(1, C) = TT
Next
_以空白格剖析文字,再向右逐一填入 

TOP

回復 7# Jason80Lo


Do Until EOF(1)
  Line Input #1, T
  If T = "&" Then Set xR = xEnd(1, "B"): C = 0
  If (T = "#" Or T = "$") And N = "" Then Set xR = xEnd(1, "M"): C = 0: N = "Y"
  If T = "@" Then Set xR = xEnd(1, "AO"): C = 0
  For Each TT In Split(T, " ")
    C = C + 1:   xR(1, C) = TT
  Next
Loop

TOP

回復 10# Jason80Lo


If (T = "#" Or T = "$") And N = "" Then Set xR = xEnd(1, "M"): C = 0: N = "Y"
_當遇"#"或"$",即以最後列的M欄為填入資料的起始格,
 因"#"與"$"個數不一定,且時有時無,又位置沒有既定順序,
 所以,只要遇到第一個"#"或"$",即以N="Y"表示已取得起始格,其後的就算是累計個數∼∼
 
資料要有固定規則(依提供的是三段式),否則程式無法寫的!

TOP

回復 12# Jason80Lo


N = "" '在這裡加入
Open xPath & xF For Input Access Read As #1


因第一個文字檔執行後 N = "Y",
所以每次都要將 N 設回空值,才不會被錯誤引用!

TOP

回復 15# Jason80Lo


Sub TEST()
Dim xPath$, xF$, xS As Worksheet, xEnd As Range, xR As Range, TT, T, N$, C%
xPath = ThisWorkbook.Path & "\" '"C:\Users\j\Desktop\VBA TXT 依照段落開啟需求\"
Set xS = ThisWorkbook.Sheets("工作表1")
Do
 If xF = "" Then xF = Dir(xPath & "\*.txt") Else xF = Dir
 If xF = "" Then Exit Do
 If Not xS.[A:A].Find(xF, LookAT:=xlWhole) Is Nothing Then GoTo 101
 Set xEnd = xS.Cells(Rows.Count, 1).End(xlUp)(2)
 If xEnd.Row < 3 Then Set xEnd = xS.[A3]
 xEnd = xF
 
 N = "" 
 Open xPath & xF For Input Access Read As #1
 Do Until EOF(1)
   Line Input #1, T
   If T = "&" Then Set xR = xEnd(1, "B"): C = 0
   If T = "$" Then Set xR = xEnd(1, "BG"): C = 0
   If (T = "#" Or T = "%") And N = "" Then Set xR = xEnd(1, "FZ"): C = 0: N = "Y"
   If T = "@" Then Set xR = xEnd(1, "DX"): C = 0
   For Each TT In Split(T, " ")
     C = C + 1:   xR(1, C) = TT
   Next
 Loop
 Close #1
101: Loop
End Sub

TOP

        靜思自在 : 愛不是要求對方,而是要由自身的付出。
返回列表 上一主題