- 帖子
- 2798
- 主題
- 10
- 精華
- 0
- 積分
- 2854
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-4-20
|
回復 3# 朱子
Sub 匯入()
Dim xFile$, TxtStr$, T$, TR, Arr, i&, N&
Intersect(ActiveSheet.UsedRange, [A:G]).Offset(1, 0).EntireRow.Delete
xFile = ThisWorkbook.Path & "\data2.txt"
With CreateObject("ADODB.Stream")
.Charset = "UTF-8"
.Open
.LoadFromFile xFile
TxtStr = .ReadText
.Close
End With
TR = Split(TxtStr, vbCrLf)
ReDim Arr(1 To UBound(TR), 1 To 7)
For i = 0 To UBound(TR)
If Len(TR(i)) < 2 Then GoTo 101
If Left(TR(i), 6) = "標 準 別：" Then T = Mid(TR(i), 7): GoTo 101
If T = "" Then GoTo 101
N = N + 1
TR(i) = Replace(TR(i), """", "|")
Arr(N, 1) = T '標準別
Arr(N, 2) = Trim(Evaluate("MidB(""" & TR(i) & """, 1, 10)")) '處置代碼
Arr(N, 3) = Replace(Trim(Evaluate("MidB(""" & TR(i) & """, 11, 30)")), "|", """") '處置名稱
Arr(N, 4) = Trim(Evaluate("MidB(""" & TR(i) & """, 41, 10)")) '成本中心
Arr(N, 5) = Trim(Evaluate("MidB(""" & TR(i) & """, 51, 10)")) '處置類別
Arr(N, 6) = Trim(Evaluate("MidB(""" & TR(i) & """, 61, 10)")) '健保單價
Arr(N, 7) = Trim(Evaluate("MidB(""" & TR(i) & """, 71, 10)")) '自費單價
101: Next i
If N > 0 Then [A2].Resize(N, 7) = Arr
End Sub
'=============================== |
|
發表於 2020-2-15 13:19
| 
