dou10801

回復 10# Andy2483
With Workbooks.Open(xlsPath, , True).Sheets(2)
1.選取22.XLSX為例.
2,會產生[工作表一]的資料,且不是字串組合.
mcs = "" & mcs1 & Cells(R, MDS2) & Format(Cells(R, MDS3), "00000000000") & "00" & mcs2 & Cells(R, MDS4) & String(p2, " ")

Andy2483

回復 11# dou10801


   
With Workbooks.Open(xlsPath, , True).Sheets(2)
       .Activate
      .Cells.NumberFormatLocal = "@"
      Arr = .[A1].CurrentRegion
      brr = .[A1].CurrentRegion

下載 (43.27 KB)

2023-10-30 13:58

dou10801

回復 12# Andy2483
方法1.:
With Workbooks.Open(xlsPath, , True).Sheets(Val(MP1))
"3"是字串,指定3索引號工作表必須將字串 "3" 轉化為數值 3

方法2.:
宣告為短整數:
Dim MP1%
MP1 = Range("B7")
With Workbooks.Open(xlsPath, , True).Sheets(MP1)

mcs = "'" & mcs1 & Cells(R, MDS2) & Format(Cells(R, MDS3),~~

With Workbooks.Open(xlsPath, , True).Sheets(2)
    .Activate
  .Cells.NumberFormatLocal = "@"

此次問答,感謝前輩,不吝賜教指導,學到很多小細節,感恩感恩.

Andy2483

回復 13# dou10801


    將每個變數都做宣告 可以讓邏輯更清楚,建議養成習慣

dou10801

回復 14# Andy2483
以選22.XLSX,第3工作表為例,末筆資料,[合計]字樣為何拿不掉.請前輩指點,謝謝.
If Cells(R, 3) <> "" Then    '已判斷C欄空白不加入BRR(),但產生檔還是有[合計]字樣.
            p1 = Len(Cells(R, MDS4))  '備註欄長度.
            p2 = 29 - p1              '補空白長度
            mcs = "" & mcs1 & Cells(R, MDS2) & Format(Cells(R, MDS3), "00000000000") & "00" & mcs2 & Cells(R, MDS4) & String(p2, " ")
            brr(R, 1) = mcs
          End If

Andy2483

回復 15# dou10801


   
      Arr = .[A1].CurrentRegion
      'brr = .[A1].CurrentRegion
      ReDim brr(1 To UBound(Arr), 1 To 1)
      'MsgBox UBound(Arr)
      For R = 1 To UBound(Arr)

Andy2483

回復 1# dou10801


    以下是練習的方案,請前輩參考

Option Explicit
Sub 按鈕1_Click()
Application.DisplayAlerts = False
Dim MyFile, Arr, Brr$(), p2%, myPath$, R&, Q, MDS$(2 To 4), Nm$, Sc%, mcs1$, mcs2$
MyFile = Application.GetOpenFilename("Excel檔,*.XLS*")
If MyFile = "False" Then Exit Sub
Q = Split([B6], ",")
myPath = ThisWorkbook.Path & "\"
mcs1 = [B1] & Mid([B2], 2, 6) & [B3] & [B4]
mcs2 = [B5]: Sc = Val([B7])
With Workbooks.Open(MyFile, , True)
   Nm = .Name
   If Sc > .Worksheets.Count Then MsgBox Nm & " 活頁簿沒有第" & Sc & " 個表": .Close 0: Exit Sub
   With .Sheets(Sc)
      If Not .AutoFilter Is Nothing Then If .FilterMode = True Then .ShowAllData
      Arr = Range(.[G1], .[A65536].End(3))
   End With
   .Close 0
End With
If UBound(Arr) = 1 Then MsgBox Nm & " 活頁簿第" & Sc & " 個表沒有資料": Exit Sub
ReDim Brr(1 To UBound(Arr) - 1, 1 To 1)
For R = 2 To UBound(Arr)
   If Arr(R, 3) <> "" Then
      p2 = 29 - Len(Arr(R, Val(Q(2))))
      MDS(2) = Arr(R, Val(Q(0)))
      MDS(3) = Format(Arr(R, Val(Q(1))), "00000000000")
      MDS(4) = Arr(R, Val(Q(2)))
      Brr(R - 1, 1) = mcs1 & MDS(2) & MDS(3) & "00" & mcs2 & MDS(4) & String(p2, " ")
   End If
Next R
Workbooks.Add
[A1].Resize(UBound(Arr) - 1, 1) = Brr
Nm = StrReverse(Mid(StrReverse(Nm), InStr(StrReverse(Nm), ".") + 1))
ActiveWorkbook.SaveAs myPath & Nm & ".TXT", 42
ActiveWindow.Close
ThisWorkbook.Activate
MsgBox "產生媒體檔:" & myPath & Nm & ".TXT"
End Sub

dou10801

回復 17# Andy2483
學到另一種方式,感激不盡.

Andy2483

謝謝論壇,謝謝各位前輩
以下心得註解,請各位前輩指教

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

准提部林

參考檔//
媒體轉帳文字檔.rar (22.52 KB)

下載次數: 9

2023-10-31 20:02