dou10801

¦^´_ 10# Andy2483
With Workbooks.Open(xlsPath, , True).Sheets(2)
1.¿ï¨ú22.XLSX¬°¨Ò.
2,·|²£¥Í[¤u§@ªí¤@]ªº¸ê®Æ,¥B¤£¬O¦r¦ê²Õ¦X.
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

¤U¸ü (43.27 KB)

2023-10-30 13:58

dou10801

¦^´_ 12# Andy2483
¤èªk1.:
With Workbooks.Open(xlsPath, , True).Sheets(Val(MP1))
"3"¬O¦r¦ê,«ü©w3¯Á¤Þ¸¹¤u§@ªí¥²¶·±N¦r¦ê "3" Âà¤Æ¬°¼Æ­È 3

¤èªk2.:
«Å§i¬°µu¾ã¼Æ:
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 = "@"

¦¹¦¸°Ýµª,·PÁ«e½ú,¤£§[½ç±Ð«ü¾É,¾Ç¨ì«Ü¦h¤p²Ó¸`,·P®¦·P®¦.

Andy2483

¦^´_ 13# dou10801


    ±N¨C­ÓÅܼƳ£°µ«Å§i ¥i¥HÅýÅÞ¿è§ó²M·¡,«Øij¾i¦¨²ßºD

dou10801

¦^´_ 14# Andy2483
¥H¿ï22.XLSX,²Ä3¤u§@ªí¬°¨Ò,¥½µ§¸ê®Æ,[¦X­p]¦r¼Ë¬°¦ó®³¤£±¼.½Ð«e½ú«üÂI,ÁÂÁÂ.
If Cells(R, 3) <> "" Then    '¤w§PÂ_CÄæªÅ¥Õ¤£¥[¤JBRR(),¦ý²£¥ÍÀÉÁÙ¬O¦³[¦X­p]¦r¼Ë.
            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


    ¥H¤U¬O½m²ßªº¤è®×,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub «ö¶s1_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 & " ¬¡­¶Ã¯¨S¦³²Ä" & 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 & " ­Óªí¨S¦³¸ê®Æ": 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 "²£¥Í´CÅéÀÉ:" & myPath & Nm & ".TXT"
End Sub

dou10801

¦^´_ 17# Andy2483
¾Ç¨ì¥t¤@ºØ¤è¦¡,·P¿E¤£ºÉ.

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
¥H¤U¤ß±oµù¸Ñ,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub «ö¶s1_Click()
Application.DisplayAlerts = False
'¡ô¥O°õ¦æ¨ì¬O§_Àx¦s¨ú¥NÂÂÀÉ®É,¤£¸õ¥X¸ß°Ýµ¡,ª½±µ¨ú¥NÀx¦s
Dim MyFile, Arr, Q, Brr$(), R&, Sc%, p2%, MDS$(2 To 4), mcs1$, mcs2$, Nm$, myPath$
'¡ô«Å§iÅܼÆ:(MyFile,Arr,Q)¬O³q¥Î«¬ÅܼÆ,Brr¬O°}¦C(°}¦C­È¬°¦r¦ê),R¬Oªø¾ã¼Æ,
'(Sc,p2)¬Oµu¾ã¼Æ,MDS¬O¤@ºû°}¦C(¯Á¤Þ¸¹2~4),(mcs1, mcs2,Nm,myPath)¬O¦r¦êÅܼÆ
MyFile = Application.GetOpenFilename("ExcelÀÉ,*.XLS*")
'¡ô¥OMyFile³o³q¥Î«¬ÅܼƬO Åã¥Ü¼Ð·Çªº [¶}±ÒÂÂÀÉ] ¹ï¸Ü¤è¶ô¡A±q¨Ï¥ÎªÌ¨ú±oÀɮתº¦WºÙ
https://learn.microsoft.com/zh-t ... ion.getopenfilename
If MyFile = False Then Exit Sub
'¡ô¦pªGMyFileÅܼƬOÅÞ¿è­È False,¥Nªí¨S¦³¿ï¨úÀÉ®×,µ²§ôµ{§Ç°õ¦æ
Q = Split([B6], ",")
'¡ô¥OQ³o³q¥Î«¬ÅܼƬO[B6]Àx¦s®æ¥H ³r¸¹¤À³Î¦¨ªº¤@ºû°}¦C
myPath = ThisWorkbook.Path & "\"
'¡ô¥OmyPath³o¦r¦êÅܼƬO ¥»¬¡­¶Ã¯©Ò¦bªº¸ô®|³s±µ "\"©Ò²Õ¦¨ªº¦r¦ê
mcs1 = [B1] & Mid([B2], 2, 6) & [B3] & [B4]
'¡ô¥Omcs1³o¦r¦êÅܼƬO [B1]Àx¦s®æ­È,³s±µ[B2]Àx¦s®æ­È¨ú²Ä2¦r¤¸¶}©lªº6¦r¤¸¦r¦ê,
'¦A³s±µ[B3]Àx¦s®æ­È,³Ì«á³s±µ[B4]Àx¦s®æ­È,²Õ¦X¦¨ªº¦r¦ê
mcs2 = [B5]: Sc = Val([B7])
'¡ô¥Omcs2³o¦r¦êÅܼƬO [B5]Àx¦s®æ­È¦r¦ê
'¥OSc³oµu¾ã¼Æ¬O [B7]Àx¦s®æ­ÈÂà¤Æªº¾ã¼Æ­È
If Sc <= 0 Then MsgBox "[B7]Àx¦s®æ¿é¤J¿ù»~": Exit Sub
'¡ô¦pªGScÅܼƤp©ó©Îµ¥©ó0!,´N¸õ¥X´£¥Üµ¡~~~,µ²§ôµ{§Ç°õ¦æ
With Workbooks.Open(MyFile, , True)
'¡ô¥H¤U¬OÃö©ó µL±K½X/°ßŪ/¶}±ÒMyFileÅÜ¼Æ ÂÂÀɪº¬ÛÃöµ{§Ç
   Nm = .Name
   '¡ô¥ONm³o¦r¦êÅܼƬO ³o¶}±ÒÀɮצW¦r¦r¦ê
   If Sc > .Worksheets.Count Then MsgBox Nm & " ¬¡­¶Ã¯¨S¦³²Ä" & Sc & " ­Óªí": .Close 0: Exit Sub
   '¡ô¦pªGScÅܼƤj©ó¦¹ÂÂÀɤu§@ªí¼Æ¶q!´N¸õ¥X´£µøµ¡~~~,Ãö³¬ÀÉ®×(¤£Àx¦s),µ²§ôµ{§Ç°õ¦æ
   With .Sheets(Sc)
   '¡ô¥H¤U¬OÃö©ó¦¹ÂÂÀɪº²Ä ScÅܼƭӤu§@ªíªº¬ÛÃöµ{§Ç
      If Not .AutoFilter Is Nothing Then If .FilterMode = True Then .ShowAllData
      '¡ô¦pªG¦³¿z¿ï¥\¯à!´N§PÂ_¦pªG¬O¿z¿ïª¬ºA!¥O²M°£¿z¿ï
      Arr = Range(.[G1], .[A65536].End(3))
      '¡ô¥OArr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H¸Óªíªº[G2]¨ìAÄæ³Ì«á¦³¤º®eªºÀx¦s®æ,
      '¦¹½d³òÀx¦s®æ­È±a¤J°}¦C¤¤
   End With
   .Close 0
   '¡ô¥O¸ÓÂÂÀÉÃö³¬(¤£Àx¦s)
End With
If UBound(Arr) = 1 Then MsgBox Nm & " ¬¡­¶Ã¯²Ä" & Sc & " ­Óªí¨S¦³¸ê®Æ": Exit Sub
'¡ô¦pªGArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹¬O 1!´N¸õ¥X´£µøµ¡~~~,µ²§ôµ{§Ç°õ¦æ
ReDim Brr(1 To UBound(Arr) - 1, 1 To 1)
'¡ô«Å§iBrr°}¦CÁa¦V½d³ò±q¯Á¤Þ¸¹1 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹-1,¾î¦V½d³ò±q1~1¯Á¤Þ¸¹
For R = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!¥ORÅܼƱq2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If Arr(R, 3) <> "" Then
   '¡ô¦pªGR°j°é¦C²Ä3ÄæArr°}¦C­È¤£¬OªÅ¦r¤¸?
      p2 = 29 - Len(Arr(R, Val(Q(2))))
      '¡ô¥Op2³oµu¾ã¼ÆÅܼƬO 29-(°j°é°}¦C­Èªº¦r¤¸¼Æ)
      '°j°é°}¦C­È:(R°j°é¦C,2¯Á¤Þ¸¹Q°}¦C­ÈÂର¼Æ­ÈªºÄ渹)Arr°}¦C­È
      MDS(2) = Arr(R, Val(Q(0)))
      '¡ô¥O2¯Á¤Þ¸¹MDS°}¦C­È¬O (R°j°é¯Á¤Þ¦C,0¯Á¤Þ¸¹Q°}¦C­ÈÂର¼Æ­Èªº¯Á¤ÞÄ渹)Arr°}¦C­È
      MDS(3) = Format(Arr(R, Val(Q(1))), "00000000000")
      '¡ô¥O3¯Á¤Þ¸¹MDS°}¦C­È¬O (R°j°é¯Á¤Þ¦C,1¯Á¤Þ¸¹Q°}¦C­ÈÂର¼Æ­Èªº¯Á¤ÞÄ渹)Arr°}¦C­È,
      '¦A±N¦¹­ÈÂà¤Æ¬° "00000000000"®æ¦¡ªº¦r¦ê
      MDS(4) = Arr(R, Val(Q(2)))
      '¡ô¥O4¯Á¤Þ¸¹MDS°}¦C­È¬O (R°j°é¯Á¤Þ¦C,2¯Á¤Þ¸¹Q°}¦C­ÈÂର¼Æ­Èªº¯Á¤ÞÄ渹)Arr°}¦C­È
      Brr(R - 1, 1) = mcs1 & MDS(2) & MDS(3) & "00" & mcs2 & MDS(4) & String(p2, " ")
      '¡ô¥O(R°j°é-1)¦C1ÄæBrr°}¦C­È¬O ±µÄò¦h­Ó¦r¦ê²Õ¦¨ªº¦r¦ê
      'String(p2, " "):¬Op2­ÓªÅ¥Õ¦r¤¸ªº¦r¦ê
   End If
Next R
Workbooks.Add
'¡ô¥O·s¼W¤@­Ó¬¡­¶Ã¯
[A1].Resize(UBound(Arr) - 1, 1) = Brr
'¡ô¥O[A1]Àx¦s®æÂX®i¦V¤U(Arr°}¦CÁa¦V³Ì¤j¯Á¤Þ¸¹-1)¦Cªº½d³òÀx¦s®æ­È¥HBrr°}¦C­È±a¤J
Nm = StrReverse(Mid(StrReverse(Nm), InStr(StrReverse(Nm), ".") + 1))
'¡ô¥ONmÅܼƦr¦ê¤ÏÂà«á ¨ú"."«á(¤£§t)ªº©Ò¦³¦r¤¸,¦A¤ÏÂà¦^¨Ó
ActiveWorkbook.SaveAs myPath & Nm & ".TXT", 42
'¡ô¥OÀx¦s¬° ¤å¦r¦rÀÉ(Unicode ¤å¦r)
https://learn.microsoft.com/zh-t ... /excel.xlfileformat
ActiveWindow.Close
'¡ô¥O¦¹µøµ¡¬¡­¶Ã¯ Ãö³¬
ThisWorkbook.Activate
'¡ô¿E¬¡¥»ÀÉ
MsgBox "²£¥Í´CÅéÀÉ:" & myPath & Nm & ".TXT"
'¡ô¸õ¥X´£¥Üµ¡ ~~~
End Sub

­ã´£³¡ªL

°Ñ¦ÒÀÉ//
´CÅéÂà±b¤å¦rÀÉ.rar (22.52 KB)

¤U¸ü¦¸¼Æ: 9

2023-10-31 20:02