- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
19#
發表於 2023-10-31 14:45
| 只看該作者
謝謝論壇,謝謝各位前輩
以下心得註解,請各位前輩指教
Option Explicit
Sub 按鈕1_Click()
Application.DisplayAlerts = False
'↑令執行到是否儲存取代舊檔時,不跳出詢問窗,直接取代儲存
Dim MyFile, Arr, Q, Brr$(), R&, Sc%, p2%, MDS$(2 To 4), mcs1$, mcs2$, Nm$, myPath$
'↑宣告變數:(MyFile,Arr,Q)是通用型變數,Brr是陣列(陣列值為字串),R是長整數,
'(Sc,p2)是短整數,MDS是一維陣列(索引號2~4),(mcs1, mcs2,Nm,myPath)是字串變數
MyFile = Application.GetOpenFilename("Excel檔,*.XLS*")
'↑令MyFile這通用型變數是 顯示標準的 [開啟舊檔] 對話方塊，從使用者取得檔案的名稱
https://learn.microsoft.com/zh-t ... ion.getopenfilename
If MyFile = False Then Exit Sub
'↑如果MyFile變數是邏輯值 False,代表沒有選取檔案,結束程序執行
Q = Split([B6], ",")
'↑令Q這通用型變數是[B6]儲存格以 逗號分割成的一維陣列
myPath = ThisWorkbook.Path & "\"
'↑令myPath這字串變數是 本活頁簿所在的路徑連接 "\"所組成的字串
mcs1 = [B1] & Mid([B2], 2, 6) & [B3] & [B4]
'↑令mcs1這字串變數是 [B1]儲存格值,連接[B2]儲存格值取第2字元開始的6字元字串,
'再連接[B3]儲存格值,最後連接[B4]儲存格值,組合成的字串
mcs2 = [B5]: Sc = Val([B7])
'↑令mcs2這字串變數是 [B5]儲存格值字串
'令Sc這短整數是 [B7]儲存格值轉化的整數值
If Sc <= 0 Then MsgBox "[B7]儲存格輸入錯誤": Exit Sub
'↑如果Sc變數小於或等於0!,就跳出提示窗~~~,結束程序執行
With Workbooks.Open(MyFile, , True)
'↑以下是關於 無密碼/唯讀/開啟MyFile變數 舊檔的相關程序
Nm = .Name
'↑令Nm這字串變數是 這開啟檔案名字字串
If Sc > .Worksheets.Count Then MsgBox Nm & " 活頁簿沒有第" & Sc & " 個表": .Close 0: Exit Sub
'↑如果Sc變數大於此舊檔工作表數量!就跳出提視窗~~~,關閉檔案(不儲存),結束程序執行
With .Sheets(Sc)
'↑以下是關於此舊檔的第 Sc變數個工作表的相關程序
If Not .AutoFilter Is Nothing Then If .FilterMode = True Then .ShowAllData
'↑如果有篩選功能!就判斷如果是篩選狀態!令清除篩選
Arr = Range(.[G1], .[A65536].End(3))
'↑令Arr這通用型變數是 二維陣列,以該表的[G2]到A欄最後有內容的儲存格,
'此範圍儲存格值帶入陣列中
End With
.Close 0
'↑令該舊檔關閉(不儲存)
End With
If UBound(Arr) = 1 Then MsgBox Nm & " 活頁簿第" & Sc & " 個表沒有資料": Exit Sub
'↑如果Arr陣列縱向最大索引列號是 1!就跳出提視窗~~~,結束程序執行
ReDim Brr(1 To UBound(Arr) - 1, 1 To 1)
'↑宣告Brr陣列縱向範圍從索引號1 到Arr陣列縱向最大索引列號-1,橫向範圍從1~1索引號
For R = 2 To UBound(Arr)
'↑設順迴圈!令R變數從2 到Arr陣列縱向最大索引列號
If Arr(R, 3) <> "" Then
'↑如果R迴圈列第3欄Arr陣列值不是空字元?
p2 = 29 - Len(Arr(R, Val(Q(2))))
'↑令p2這短整數變數是 29-(迴圈陣列值的字元數)
'迴圈陣列值:(R迴圈列,2索引號Q陣列值轉為數值的欄號)Arr陣列值
MDS(2) = Arr(R, Val(Q(0)))
'↑令2索引號MDS陣列值是 (R迴圈索引列,0索引號Q陣列值轉為數值的索引欄號)Arr陣列值
MDS(3) = Format(Arr(R, Val(Q(1))), "00000000000")
'↑令3索引號MDS陣列值是 (R迴圈索引列,1索引號Q陣列值轉為數值的索引欄號)Arr陣列值,
'再將此值轉化為 "00000000000"格式的字串
MDS(4) = Arr(R, Val(Q(2)))
'↑令4索引號MDS陣列值是 (R迴圈索引列,2索引號Q陣列值轉為數值的索引欄號)Arr陣列值
Brr(R - 1, 1) = mcs1 & MDS(2) & MDS(3) & "00" & mcs2 & MDS(4) & String(p2, " ")
'↑令(R迴圈-1)列1欄Brr陣列值是 接續多個字串組成的字串
'String(p2, " "):是p2個空白字元的字串
End If
Next R
Workbooks.Add
'↑令新增一個活頁簿
[A1].Resize(UBound(Arr) - 1, 1) = Brr
'↑令[A1]儲存格擴展向下(Arr陣列縱向最大索引號-1)列的範圍儲存格值以Brr陣列值帶入
Nm = StrReverse(Mid(StrReverse(Nm), InStr(StrReverse(Nm), ".") + 1))
'↑令Nm變數字串反轉後 取"."後(不含)的所有字元,再反轉回來
ActiveWorkbook.SaveAs myPath & Nm & ".TXT", 42
'↑令儲存為 文字字檔(Unicode 文字)
https://learn.microsoft.com/zh-t ... /excel.xlfileformat
ActiveWindow.Close
'↑令此視窗活頁簿 關閉
ThisWorkbook.Activate
'↑激活本檔
MsgBox "產生媒體檔:" & myPath & Nm & ".TXT"
'↑跳出提示窗 ~~~
End Sub |
|
發表於 2023-11-2 15:53
| 