- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
¥»©«³Ì«á¥Ñ Andy2483 ©ó 2023-11-3 07:20 ½s¿è
¦^´_ 20# ã´£³¡ªL
ÁÂÁ½׾Â,ÁÂÁ«e½ú«ü¾É
¥H¤U¬OÃjÀ´ªº¤ß±oµù¸Ñ,½Ð«e½ú¦A«ü¾É
Sub Test_a1()
Dim xFile$, T1$, T2$, BN$, SN$, P$, PP$, Sx%, Cn, Arr, i&
'¡ô«Å§iÅܼÆ:(xFile,T1,T2,BN,SN,P,PP)¬O¦r¦êÅܼÆ,Sx¬Oµu¾ã¼ÆÅܼÆ,
'(Cn,Arr)¬O³q¥Î«¬ÅܼÆ,i¬Oªø¾ã¼ÆÅܼÆ
ChDir ThisWorkbook.Path
'¡ôChDir "D:\" '«ü©w¶}±ÒÀɮתº¸ô®|
xFile = Application.GetOpenFilename("ExcelÀÉ,*.XLS*")
'¡ô¥OxFile³o¦r¦êÅܼƬO Åã¥Ü¼Ð·Çªº [¶}±ÒÂÂÀÉ] ¹ï¸Ü¤è¶ô¡A±q¨Ï¥ÎªÌ¨ú±oÀɮתº¦WºÙ
If xFile = "False" Then Exit Sub
'¡ô¦pªGxFileÅܼƬO¦r¦ê"False",¥Nªí¨S¦³¿ï¨úÀÉ®×,µ²§ôµ{§Ç°õ¦æ
T1 = [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¦ê (¤å¦r¦ê«e½X)
T2 = [b5]
'¡ô¥OT2³o¦r¦êÅܼƬO[b5]Àx¦s®æÈ (¦s´£´Ú¥N¸¹)
Sx = Val([b7])
'¡ô¥OSx³o¦r¦êÅܼƬO [b7]Àx¦s®æÈÂà¤Æªº¾ã¼ÆÈ («ü©w²Ä?±i¤u§@ªí(¨Ì¥ª¦Ó¥k¶¶§Ç))
Cn = Split([b6], ",")
'¡ô¥OCn³o³q¥Î«¬ÅܼƬO [b6]Àx¦s®æ¥H ³r¸¹¤À³Î¦¨ªº¤@ºû°}¦C («ü©wÄæ¦ì)
'---------------------------------
On Error Resume Next
'¡ô¥Oµ{§Ç°õ¦æ¤£°»¿ù
With GetObject(xFile)
'¡ô¥H¤U¬OÃö©ó¥HxFileÅܼƥÎGetObject¨ç¦¡ ¦^¶Çª«¥ó(¬¡¶Ã¯)ªºµ{§Ç
'ÁÂÁ «e½ú«ü¾É³o¨ç¦¡ªº¥Îªk
'°õ¦æ¨ì³o¸Ì¨Ã¨S¦³¬Ý¨ì¶}±Ò¬¡¶Ã¯,«Ü¯«©_!«á¨Ó¬d¬Ý¨ì¬¡¶Ã¯µøµ¡³QÁôÂð_¨Ó¤F
'¦pªG¸Ó¬¡¶Ã¯ì¥»´N³Q¶}±Ò·|ª½±µ«ü¦V¦¹¬¡¶Ã¯,¤£·|¦A«·s¶}±Ò¤@¦¸
https://learn.microsoft.com/zh-t ... /getobject-function
BN = Split(.Name, ".")(0)
'¡ô¥OBN³o¦r¦êÅܼƬO ¬¡¶Ã¯ÀɦW(¥h°£°ÆÀɦW)
'(¥h°£°ÆÀɦW¤èªk:¥H"."²Å¸¹¤À³Î¬¡¶Ã¯¦WºÙ,¨ú0¯Á¤Þ¸¹°}¦CÈ)
SN = .Sheets(Sx).Name
'¡ô¥OSN³o¦r¦êÅܼƬO¬¡¶Ã¯¸Ì²ÄSxÅܼƯÁ¤Þ¸¹¤u§@ªí¦WºÙ
Arr = Range(.Sheets(Sx).[g1], .Sheets(Sx).UsedRange) '¸ê®Æ½d³ò(§tGÄæ)
'¡ô¥OArr³o³q¥Î«¬ÅܼƬO¤Gºû°}¦C,¥H¤w¨Ï¥ÎÀx¦s®æ(§tGÄæ)½d³òÀx¦s®æȱa¤J
.Close 0
'¡ô¥O¬¡¶Ã¯Ãö³¬(¤£Àx¦s)
End With
On Error GoTo 0
'¡ô¥Oµ{§Ç«ì´_°»¿ù
If SN = "" Then MsgBox "«ü©w¤u§@ªí¤£¦s¦b! ": Exit Sub
'¡ô¦pªGSNÅܼƬO ªÅªº!´N¸õ¥X´£µøµ¡~~~ ,µ²§ôµ{§Ç°õ¦æ
'----------------------------------
For i = 2 To UBound(Arr)
'¡ô³]¶¶°j°é!i±q2 ¨ìArr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
P = T1 & Arr(i, Cn(0))
'¡ô¥OP³o¦r¦êÅܼƬO T1ÅܼƳs±µ i°j°é¦C(0¯Á¤Þ¸¹Cn°}¦CÈ)ÄæArr°}¦CÈ
P = P & Format(Arr(i, Cn(1)), "00000000000;;#") & "00" & T2
'¡ô¥OPÅܼƦA³s±µ i°j°é¦C(1¯Á¤Þ¸¹Cn°}¦CÈ)ÄæArr°}¦CÈ¥HFormat¨ç¦¡¦^¶Ç¦r¦ê,
'¦A³s±µ "00",Äò³s±µT2ÅܼÆ
'³o;;#¤À°Ï¬q²{¦bÁÙ¤£¯à²z¸Ñ,»Ýn§ó¦h¾Ç²ß
https://learn.microsoft.com/zh-t ... ic-for-applications
P = P & Left(Arr(i, Cn(2)) & String(29, " "), 29)
'¡ô¥OPÅܼƦA³s±µ 29Ó¦r¤¸ªº¦r¦ê:
'i°j°é¦C(2¯Á¤Þ¸¹Cn°}¦CÈ)ÄæArr°}¦CÈ ³s±µ29Ӫťզr¤¸,©Ò²Õ¦¨ªº·s¦r¦ê,¨ú¥ª°¼29Ó¦r¤¸
If Len(P) = 80 Then PP = PP & IIf(PP = "", "", vbCrLf) & P
'¡ô¦pªGPÅܼƦr¤¸¼Æ¬O80!´N¥OPP³o¦r¦êÅܼƲּW¥[¦r¦ê(Âk¦ì¦r¤¸´«¦æ²Õ¦X)¶¡¹j
'¤å¦rÀÉ(.Txt)ÀÉ»ÝnvbCrLf = CHR(13)+CHR(10) ¤~·|´«¦æ
https://learn.microsoft.com/zh-t ... ellaneous-constants
i01: Next i
If PP = "" Then MsgBox "«ü©w¤u§@ªíµL²Å¦X¸ê®Æ! ": Exit Sub
'¡ô¦pªGPPÅܼƬOªÅªº!´N¸õ¥X´£µøµ¡~~~ ,µ²§ôµ{§Ç°õ¦æ
'----------------------------------
xFile = ThisWorkbook.Path & "\" & BN & "-Sheets(" & Sx & ").TXT"
Open xFile For Output As #1 'OutputÂл\¸ê®Æ
'¡ô¥H¶¶§Ç¿é¤J¼Ò¦¡¶}±Ò ÀÉ®×
https://learn.microsoft.com/en-u ... help/open-statement
Print #1, PP
'¡ô±NÅã¥Ü®æ¦¡¤Æ¸ê®Æ Âл\¸ê®Æ¼g¤JÀÉ®×
https://learn.microsoft.com/zh-t ... help/printstatement
Close #1
'¡ôÃö³¬ÀÉ®×
MsgBox "¤å¦rÀɤw«Ø¥ß¡G" & xFile
End Sub |
|