- ©«¤l
- 5923
- ¥DÃD
- 13
- ºëµØ
- 1
- ¿n¤À
- 5986
- ÂI¦W
- 0
- §@·~¨t²Î
- win10
- ³nÅ骩¥»
- Office 2010
- ¾\ŪÅv
- 150
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW°ò¶©
- µù¥U®É¶¡
- 2010-5-1
- ³Ì«áµn¿ý
- 2022-1-23
        
|
¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-27 15:24 ½s¿è
¦^´_ 34# smart3135 - Option Explicit
- Private Sub Test()
- Dim fs As Object, E As Range, C As Variant
- Set fs = CreateObject("Scripting.FileSystemObject")
- Set fs = fs.CreateTextFile("D:\°]³ø¸ê®Æ\1101\Test.TXT", True)
- '³Ð¨£¤@ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
- '¤å¦rÀɪº¼g¤J¬O
- For Each E In Sheets(1).UsedRange.Columns
- C = E.Value '-> °}¦C(1 To ¦C¼Æ,1 To øó¼Æ)ªº¤Gºû°}¦C
- C = Application.Transpose(E.Value) '¦]¬°²Ä¤Gºû¥u¦³¤@Äæ,Âà¸m¤@¦¸¥iÅܬ°¤@ºû°}¦C
- '¦pE In UsedRange.rows
- 'C = E.Value '-> °}¦C(1 To ¦C¼Æ,1 To øó¼Æ)ªº¤Gºû°}¦C
- 'C = Application.Transpose(Application.Transpose(E.Value)) '²Ä¤Gºû¤£¥u¤@Äæ,©Ò¥HÂà¸m¤G¦¸¤~¥iÅܬ°¤@ºû°}¦C
- C = Join(C, vbTab)
- 'Join ¨ç¼Æ ¶Ç¦^¤@Ó¦r¦ê¡A¸Ó¦r¦ê¬O³z¹L³sµ²¬YÓ°}¦C¤¤ªº¦hÓ¤l¦r¦ê¦Ó«Ø¥ßªº¡C
- 'Join ¨ç¼Æ ¨Ï¥Îªº°}¦C¥²¶·¬O¤@ºû°}¦C
- fs.WriteLine C
- Next
- fs.Close
- End Sub
½Æ»s¥N½X
¸Ô¬Ýµù¸Ñ¥i©úÁA.-
- Option Explicit
- Sub §ì©u¤ëÀ禬¸ê®Æ()
- Dim E As Integer, URL As String, xPath As String, xFile As String
- Dim i As Integer, ii As Integer, Rng As Range, S1 As String, S2 As String, t As Date
- Dim AR()
- t = Time
- URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCH/ZCH.DJHTM?A="
- xPath = "D:\°]³ø¸ê®Æ"
- Application.DisplayStatusBar = True
- With ThisWorkbook
- '¨âªÌ¨ú¤@§Y¥i (¿ï¾ÜÀx¦s®æ¸û¤è«K)
- '***'¤£»ÝnªºªÑ²¼¦p4203¤Ñ¤¯(«á§ì¨ú)¬O¿ù»~ªºªÑ²¼¸¹½X ¸m¤J-> Ar°}¦C
- ' AR = Array(1202, 1420, 1433, 1502, 1518, 1610, 1716, 2346, 2372, 2391, 2513, 2526, 2541, 2802, 2803, 2804, 2806, _
- 2813, 2814, 2815, 2817, 2818, 2819, 2821, 2826, 2830, 2839, 2840, 2843, 2844, 2848, 2907, 2909, 4101, 4112, _
- 4175, 4201, 4203, 4204, 4301, 4302, 4405, 4407, 4409, 4410, 4411, 4412, 4504, 4505, 4507, 4508, 4509, 4512, _
- 4514, 4516, 4517, 4519, 4520, 4521, 4524, 4525, 4531, 4603, 4604, 4605, 4606, 4607, 4608, 4701, 4704, 4705, _
- 4708, 4709, 4710, 4713, 4715, 4718, 4901, 4902, 5001, 5003, 5004, 5005, 5012, 5101, 5311, 5319, 5320, 5322, _
- 5323, 5327, 5330, 5331, 5334, 5335, 5337, 5341, 5342, 5354, 5357, 5358, 5359, 5360, 5361, 5362, 5363, 5366, _
- 5368, 5369, 5374, 5377, 5379, 5380, 5382, 5389, 5391, 5393, 5394, 5396, 5397, 5399, 5404, 5405, 5408, 5409, _
- 5411, 5412, 5415, 5416, 5417, 5418, 5419, 5420, 5421, 5422, 5423, 5424, 5427, 5428, 5430, 5431, 5433, 5435, _
- 5440, 5444, 5445, 5446, 5447, 5449, 5453, 5456, 5458, 5459, 5461, 5462, 5463, 5470, 5472, 5476, 5477, 5482, _
- 5485, 5486, 5495, 5496, 5499, 5509, 5517, 5527, 5606, 5705, 5804, 5805, 5806, 5807, 5809, 5812, 5814, 5815, _
- 5854, 6003, 6006, 6019, 6102, 6106, 6401, 6501, 8001, 8003, 8903, 8904, 8912, 8914, 8915, 8918, 8920, 8922, 8939, 9105, 9909)
-
- '***AÄ椤¤£»ÝnªºªÑ²¼ ¦p4203¤Ñ¤¯(«á§ì¨ú)¸¹½XªºÀx¦s®æ ¸m¤J-> Ar°}¦C
- Set Rng = .Sheets(2).Range("A:A").SpecialCells(xlCellTypeConstants)
- If Rng Is Nothing Then
- AR = Array()
- ElseIf Rng.Count = 1 Then
- AR = Array(Rng.Value)
- Else
- AR = Application.Transpose(Rng.Value)
-
- '¥ý«e¥X¿ù¬O³o¸Ì¼g¿ù AR = Application.Transpose(Application.Transpose(Rng.Value))
- 'Rng.Value=>³æÄæ¤Gºû°}¦C
- End If
- '***************************************************
- .Sheets(2).UsedRange.Offset(, 1).Clear
- Application.ScreenUpdating = False
- Application.StatusBar = " "
- With .Sheets(1) '¬¡¶Ã¯ªº²Ä 1 ±i¤u§@ªí
- If .QueryTables.Count = 0 Then
- With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
- .Refresh BackgroundQuery:=False
- End With
- End If
- .Rows(1).Delete
- .Columns(1).Delete
- For E = 1101 To 5000
- If UBound(Filter(AR, E)) > -1 Then GoTo xLnext
- 'Filter(AR, E)¨ç¼Æ µ¥¦P¨Ï¥ÎFind¤èªk ¦p Set Rng = .Find(S2, lookat:=xlPart) '·j´M:ªÑ²¼¦WºÙ
- With .QueryTables(1)
- .Connection = URL & E
- .PreserveFormatting = True
- .BackgroundQuery = True
- .RefreshStyle = xlInsertDeleteCells
- .SaveData = True
- .AdjustColumnWidth = True
- .RefreshPeriod = 0
- .WebSelectionType = xlSpecifiedTables
- .WebFormatting = xlWebFormattingNone
- .WebTables = "3"
- .WebPreFormattedTextToColumns = True
- .WebConsecutiveDelimitersAsOne = True
- .Refresh BackgroundQuery:=False
- If InStr(.ResultRange(2, 1), "¬dµL") Then '¬dµL³oÀɪѲ¼
- Mark_Code E '¬dµLªºªÑ²¼ ©ñ¸mAÄd
- GoTo xLnext
- End If
- S1 = .ResultRange(1) '¶×¤J¸ê®Æªº²Ä1ÓÀx¦s®æ
- S2 = Mid(S1, 1, InStr(S1, "(") - 1) 'ªÑ²¼¦WºÙ
- End With
-
- With ThisWorkbook.Sheets(2).Range("B:B")
- Set Rng = .Find(S2, lookat:=xlPart) '·j´M:ªÑ²¼¦WºÙ
- If Rng Is Nothing Then
- i = i + 1
- .Range("A" & i) = S1 'ªÑ²¼¦WºÙ¥N½X
- Else
- Mark_Code E '«½ÆªºªÑ²¼ ©ñ¸mAÄd
- S2 = Mid(Trim(Rng), InStr(Trim(Rng), "(") + 1)
- S2 = Mid(S2, 1, Len(S2) - 1) 'ªºªÑ²¼[¥N½X]
- xFile = xPath & "\" & S2 & "\*.*" '±þ±¼©Ò¦³ÀÉ®×
- If Dir(xFile) <> "" Then
- ii = ii - 1
- Kill xFile
- xFile = xPath & "\" & S2
- If Dir(xFile, vbDirectory) <> "" Then RmDir xFile '¸ê®Æ§¨¤]§R°£¤F
- End If
- End If
- End With
- ii = ii + 1
- xFile = xPath & "\" & E & "\REVENUE.txt"
- MkDir_Sub xFile
- Maketxt xFile, .QueryTables(1)
- xLnext:
- S1 = " " & Sheets(1).QueryTables(1).ResultRange(1)
- If Val(S1) < 0 Then S1 = " ¬dµL"
- Application.StatusBar = Application.text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J " & ii & " ¤å¦rÀÉ, Ū¨ú " & S1 & " ¤¤..."
- Next
- End With
- End With
- Application.ScreenUpdating = True
- Application.StatusBar = Application.text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J " & ii & " ¤å¦rÀÉ, Ū¨ú§¹²¦ !! "
- MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.text(Time - t, ["MM¤ÀSS¬í"])
- ThisWorkbook.Save
- End Sub
½Æ»s¥N½X- Private Sub Mark_Code(S As Integer)
- With ThisWorkbook.Sheets(2).Range("A:A") '«½ÆªºªÑ²¼ ©ñ¸mAÄd
- .Cells(Application.Count(.Cells) + 1, "A") = S
- 'ªÑ²¼¥N¸¹©ñ¸m AÄd³Ì«á¤@ÓÀx¦s®æ
- '°õ¦æ¤@¦¸«á,¤U¦¸¦A°õ¦æ [§ì©u¤ëÀ禬¸ê®Æ]µ{¦¡®É,For °j°é¤¤¥i½ð°£³oªÑ²¼¥N¸¹
- End With
- End Sub
½Æ»s¥N½X
|
|