- ©«¤l
- 1440
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1464
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-8-22
|
¦^´_ 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 |
|