ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¥i§_¥Î°j°é©ÎÅܼƶפJ¤j¶q¸ê®Æ¡H

¦^´_ 30# GBKEE
¥ý·PÁÂGBKEEª©¥D¤@¤@­@¤ßªº¦^µª¡A¦]¬°¤µ±ßÁÙ­n¤W¯Z¡A©Ò¥H±z¦b27#§ó·sªºµ{¦¡½X¡A¥i¯à­nµ¥¨ì©ú¤Ñ¤~¯àtry¤F¡I
¦Ü©ó¹q¸£´îªÎ³¡¤À
1±N¤U­±¤å¦r½Æ»s¨ì°O¨Æ¥»  ¦sÀɬ°ªþÀɦW ".BAT",¶Ç°e¨ì®à­±¤W ,¤£©w®Éªº²M²z©U§£Àɮסгo­ÓBATÀɧڤ@ª½³£¦³¦b¥Î¡A¬O§_¨C¦¸°õ¦æ§¹VBA´N­n²M¤@¦¸©O¡H
2¤£©w®Éªº²MªÅ¸ê·½¦^¦¬µ© ¡Ð³Ìªñ¥á¨ì¸ê·½¦^¦¬µ©ªº¸ê®Æ¸û¦h¡A¦³ªÅ·|¸Õ¤@¤U²MªÅ·|¤£·|¦n¤@ÂI
3 ¤£©w®É²MªÅIEªºÂsÄý°O¿ý¡Ð¥­±`³£¬O¥Îchorme¬yø°¾¹¬°¥D¡A¤£¹L³Ìªñ¦]¬°­nEXCEL¶×¤JWEB¸ê®Æ©Ò¥H¦³¤ñ¸û±`¥Î¡A·|²MªÅ¦A¨Ó¸Õ¸Õ
4 ©w®Éªº²M²zºÏºÐ¡Ð¨â¤Ñ«e¤~­è±NºÏºÐ­«²Õ
5ÂX¥R°O¾ÐÅé¡Ð§Úªº¨t²Î¬OWIN7 64¦ì¤¸+office 2007¡A°O¾ÐÅé¬O4G¡A¤£ª¾¹D³o¼Ë¦³»Ý­nÂX¥R¶Ü¡H

§Ú¦³µo²{·|¶]¨º»ò¤[¬O¦]¬°§Úµ¹ªº°Ï¶¡¶V¤j¡Aµ{¦¡¶]¨ì¶V«á­±´N¶VºC¡A¨Ò¦p§Úµ{¦¡½X³]©wFor E = 1101 to 9962¡A¥u°õ¦æ¤@¦¸¡A¶]°_¨Ó¥i¯à»Ý­n40¤ÀÄÁ
¦ý§Ú±Nµ{¦¡½X³]©wFor E = 1101 to 3000¡AFor E = 3001 to 5000¡AFor E = 5001 to 7000¡AFor E = 7001 to 9962¡A¦@°õ¦æ¥|¦¸¡A¦X­p°_¨Óªº®É¶¡´N¤£»Ý­n¨º»ò¤[
Eªº°Ï¶¡³]©w¶V¤p¡A§¹¦¨ªº®É¶¡´N¶Vµu¡A³o³¡¤À´N¤£¤Ó²z¸Ñ¬°¤°»ò·|³o¼Ë¤F¡I

¥t¥~ÁöµM±z¦b27#ªºµ{¦¡½X¤w§ó·s¡A¤£¹LÁÙ¬O§Æ±æ¯à¤F¸Ñ¤@¤U§Ú¦b28#¦V±z´£°ÝªºAR=Array(1202,1433,1502,1610.....................)³o¼Ë­n§â200­Ó¥N½X¥þ³¡¿é¤J
·|¸õ¨ì²Ä¤G¦æ¡AµM«á´N·|¥X¿ù¡A¤£ª¾¹D¦³¨S¦³¿ìªk¸Ñ¨M³o­Ó°ÝÃD©O¡H

¤£ª¾¹D³o­ÓARªºArray°Ï¶¡¦³¨S¦³¿ìªk¿é¤J200­Ó¤Þ¼Æ¥H¤W©O¡H

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-26 20:22 ½s¿è

¦^´_ 31# smart3135
³o­ÓBATÀɧڤ@ª½³£¦³¦b¥Î¡A¬O§_¨C¦¸°õ¦æ§¹VBA´N­n²M¤@¦¸©O¡H,§A­n¶]³oµ{¦¡·íµM³Ì¦n¬Oªº,Àɮ׶}¶}ÃöÃö·|»s³y¤@¨Ç¼È¦sÀÉ,´N»Ý­n²M¤@¤U
WIN7 64¦ì¤¸+office 2007¡A°O¾ÐÅé¬O4G¡A¬O¤£»ÝÂX¥R¤F,¥t´N´N¶}¾÷®É¨t²Î­n¸ü¤Ó¤Jªº±`¾nÀ³¥Îµ{¦¡.¦û¾Ú¤Ó¦hªº°O¾ÐÅé.³o¤]¬O¥D¦]¤§£¸.
XP,32¦ì¤¸, 1GB, 2003ª©, 27#µ{¦¡ For 1101 To 5000ªº°j°é ,´îªÎ«á7¤ÀÄÁ¤º·d©w.
Eªº°Ï¶¡³]©w¶V¤p¡A§¹¦¨ªº®É¶¡´N¶Vµu¡A³o³¡¤À´N¤£¤Ó²z¸Ñ¬°¤°»ò·|³o¼Ë¤F,³o¬O·Q·íµMªº
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Ar
  4.     Ar = Array(56, 78, _
  5.          9, 10, 12 _
  6.        , 888, 999, _
  7.        56789)
  8. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 32# GBKEE
«z 1101¨ì5000¶]§¹¥u­n¤C¤ÀÄÁ ¦n«Â¡I
§Ú¤§«e¤]¦³¸Õ¹L±µ¤U¤Þ¸¹¸õ¤U¤@¦æ¡A¦ý¤@ª½¥¢±Ñ¡A­ì¨Ó­n¸õ¤U¤@¦æ«e±µªº¤U¤Þ¸¹«á­±­n¦³ªÅ®æ¡A¤S¾Ç¨ì¤@©Û¤F¡A¦A¦¸·PÁ±zªº«ü¾É¡I

TOP

¦^´_ 27# GBKEE
GBKEEª©¥D¦­¦w¡A¦³¨Ç°ÝÃD·Q½Ð±Ð±z¡G
1.¤µ¦­¤U¯Z¦^¨Ó´N°¨¤W¸Õ¤F±z¬Q¤Ñ¦b27#´£¨Ñªºµ{¦¡½X¡A§Ú¦³¦A¥[¤W­n¸õ¹Lªº¥N¸¹¦bAR¤¤¡A¤]·Ó´£¥Ü±N¥N¸¹³£¿é¤J¨ìsheet(2)ªºAÄæ
ª½±µ¶]¤@¦¸¡A©_©Çªº¨Æµo¥Í¤F¡A§Ú³]©wFor E = 1101 to 5000¡A¨C¦¸¶]¨ì¤@¥b®É´N·|¥X¿ù¡A¥X¿ùªº¦ì¸m¬O¦bIf UBound(Filter(AR, E)) > -1 And UBound(AR) > -1 Then¡A¤£²M·¡­þ¸Ì¥X¤F°ÝÃD
ªþ¤Wµ{¦¡½X©MÀɮסA½Ð±zÀ°¦£¬Ý¬Ý¡@
2.¥t¥~§Ú¦³µo²{±z27#ªºµ{¦¡½X¦b¥X¿ù«eªº°õ¦æ®É³t«×«D±`§Ö¡A©M±z¥ý«e´£¨Ñªºµ{¦¡½XÅý§Ú¦b23#§¹¦¨ªºµ{¦¡¦³«Ü¤jªº¸¨®t¡A³o·í¤¤¨s³º¦³¤°»ò®t²§©O¡H¬°¤°»ò³t«×·|®t³o»ò¦h©O¡H
¤@¼Ë§Ú¨â­ÓVBAµ{¦¡³£¦³ªþ¤W¡A¤]³Â·Ð±zÀ°¦£¬Ý¬Ý¬°¤°»ò·|¦³¦p¦¹¤jªº®t²§
3.§Ú¥Î±z¥ý«e´£¨Ñªº¶]¤U¨Ó¡A²Ä¤@¬q1101 to 5000¡A¶O®É12¤À48¬í¡A§ì¤F992µ§¸ê®Æ
²Ä¤G¬q5001 to 9962¡A¶O®É13¤À50¬í¡A§ì¤F515µ§¸ê®Æ
§Ú¦b¶]²Ä¤G¬q®É¦³¥ý¨Ï¥Î²M°£¨t²Îªº.batÀÉ¡A¨Ã±NEXCELÃö³¬¦A¶}±Ò­«·s°õ¦æVBA¡Aµ²ªG¬Ý¨Ó¨Ã¨S¦³½G¨­ªº®ÄªG¡A¤£ª¾¹D¬°¤°»ò·|³o¼Ë¡H
4.¥t¥~¦b±N¸ê®Æ¶×¤Jtxtªºµ{¦¡½X¤¤¡A¦p¤U
   For Each E In Q.ResultRange.Rows
        C = Application.Transpose(Application.Transpose(E.Value))
        C = Join(C, vbTab)
        fs.WriteLine C
    Next
¨ä¤¤Q.ResultRange.RowsªºRows¬O¤£¬O¥Nªí¦C¡A¤]´N¬O±N¸ê®Æ¤@¦C¤@¦C¦s¤Jtxt¡Aª½¨ì¨S¦³¸ê®Æ¬°¤î
¤§«á§Ú¦³·Q¨ì¡A¦]¬°¥Î¤@¦C¤@¦Cªº¤è¦¡¨Ó¶×¤J¸ê®Æ­n¶]«Ü¦h¦¸°j°é¡A¦pªG¬O¥Î¤@Äæ¤@Ä檺¤è¦¡¶×¤J´N·|¤Ö¶]«Ü¦h¦¸°j°é
§Ú¦³¸ÕµÛ±NRows§ï¬°Columns¡A¦ý°õ¦æ¨ì¤U¤G¦æªºC = Join(C, vbTab)´N·|¥X¿ù¡A¤£ª¾¹D¦³¨S¦³¿ìªk¥ÎÄ檺¤è¦¡¶×¤J©O¡H

°ÝÃD¦³ÂI¦h¡A¦A³Â·Ð±zÀ°¦£¤@¤UÅo¡I·PÁ¡I
  1. Option Explicit
  2. Sub §ì©u¤ëÀ禬¸ê®Æ()
  3.     Dim E As Integer, URL As String, xPath As String, xFile As String
  4.     Dim i As Integer, ii As Integer, Rng As Range, S1 As String, S2 As String, t As Date
  5.     Dim AR()
  6.     t = Time
  7.     AR = Array(1202, 1420, 1433, 1502, 1518, 1610, 1716, 2346, 2372, 2391, 2513, 2526, 2541, 2802, 2803, 2804, 2806, _
  8.             2813, 2814, 2815, 2817, 2818, 2819, 2821, 2826, 2830, 2839, 2840, 2843, 2844, 2848, 2907, 2909, 4101, 4112, _
  9.             4175, 4201, 4203, 4204, 4301, 4302, 4405, 4407, 4409, 4410, 4411, 4412, 4504, 4505, 4507, 4508, 4509, 4512, _
  10.             4514, 4516, 4517, 4519, 4520, 4521, 4524, 4525, 4531, 4603, 4604, 4605, 4606, 4607, 4608, 4701, 4704, 4705, _
  11.             4708, 4709, 4710, 4713, 4715, 4718, 4901, 4902, 5001, 5003, 5004, 5005, 5012, 5101, 5311, 5319, 5320, 5322, _
  12.             5323, 5327, 5330, 5331, 5334, 5335, 5337, 5341, 5342, 5354, 5357, 5358, 5359, 5360, 5361, 5362, 5363, 5366, _
  13.             5368, 5369, 5374, 5377, 5379, 5380, 5382, 5389, 5391, 5393, 5394, 5396, 5397, 5399, 5404, 5405, 5408, 5409, _
  14.             5411, 5412, 5415, 5416, 5417, 5418, 5419, 5420, 5421, 5422, 5423, 5424, 5427, 5428, 5430, 5431, 5433, 5435, _
  15.             5440, 5444, 5445, 5446, 5447, 5449, 5453, 5456, 5458, 5459, 5461, 5462, 5463, 5470, 5472, 5476, 5477, 5482, _
  16.             5485, 5486, 5495, 5496, 5499, 5509, 5517, 5527, 5606, 5705, 5804, 5805, 5806, 5807, 5809, 5812, 5814, 5815, _
  17.             5854, 6003, 6006, 6019, 6102, 6106, 6401, 6501, 8001, 8003, 8903, 8904, 8912, 8914, 8915, 8918, 8920, 8922, 8939, 9105, 9909)
  18.             '¿é¤J 4203¤Ñ¤¯(«á§ì¨ú)¬O¿ù»~ªºªÑ²¼¸¹½X
  19.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCH/ZCH.DJHTM?A="
  20.     xPath = "G:\°]³ø¸ê®Æ"
  21.     With ThisWorkbook
  22.         .Sheets(2).UsedRange.Offset(, 1).Clear
  23.         '4203¤Ñ¤¯(«á§ì¨ú)¬O¿ù»~ªºªÑ²¼¸¹½X ³o¨Ç ªÑ²¼¦WºÙ(¥N¸¹) ³sÄò¤@°_¿é¤J¦bSheets(2)ªºAÄæ
  24.         Set Rng = .Sheets(2).Range("A:A").SpecialCells(xlCellTypeConstants)
  25.         If Rng Is Nothing Then
  26.             AR = Array()
  27.         ElseIf Rng.Count = 1 Then
  28.             AR = Array(Rng.Value)
  29.         Else
  30.             AR = Application.Transpose(Application.Transpose(Rng))
  31.         End If        '***************************************************
  32.         Application.ScreenUpdating = False
  33.         Application.StatusBar = " "
  34.         With .Sheets(1)      '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
  35.             If .QueryTables.Count = 0 Then
  36.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  37.                     .Refresh BackgroundQuery:=False
  38.                 End With
  39.             End If
  40.                 .Rows(1).Delete
  41.                 .Columns(1).Delete
  42.             For E = 1101 To 5000
  43.                 With .QueryTables(1)
  44.                     .Connection = URL & E
  45.                     .PreserveFormatting = True
  46.                     .BackgroundQuery = True
  47.                     .RefreshStyle = xlInsertDeleteCells
  48.                     .SaveData = True
  49.                     .AdjustColumnWidth = True
  50.                     .RefreshPeriod = 0
  51.                     .WebSelectionType = xlSpecifiedTables
  52.                     .WebFormatting = xlWebFormattingNone
  53.                     .WebTables = "3"
  54.                     .WebPreFormattedTextToColumns = True
  55.                     .WebConsecutiveDelimitersAsOne = True
  56.                     .Refresh BackgroundQuery:=False
  57.                     If .ResultRange(1) < 0 Or InStr(.ResultRange(2, 1), "¬dµL") Then GoTo xLnext
  58.                     '¶×¤J¸ê®Æªº A1 < 0  OR  ¶×¤J¸ê®Æªº A2 "¬dµL"
  59.                     S1 = .ResultRange(1)
  60.                     S2 = Mid(S1, 1, InStr(S1, "(") - 1) 'ªÑ²¼¦WºÙ
  61.                 End With
  62.                 With ThisWorkbook.Sheets(2).Range("B:B")
  63.                     Set Rng = .Find(S2, lookat:=xlPart) '·j´M:ªÑ²¼¦WºÙ
  64.                     If Rng Is Nothing Then
  65.                         i = i + 1
  66.                         .Range("A" & i) = S1  'ªÑ²¼¦WºÙ¥N½X
  67.                     Else
  68.                         Rng.Cells(1, 2) = S1   '­«½ÆªºªÑ²¼
  69.                         If UBound(Filter(AR, E)) > -1 And UBound(AR) > -1 Then
  70.                         'Filter(AR, E) > -1   '¤ñ¹ï¨ì¦p4203¤Ñ¤¯(«á§ì¨ú)¬O¿ù»~
  71.                             Rng.Cells(1, 2) = Rng.Cells(1, 2) & "***" '«á§ì¨ú¬O¿ù»~
  72.                             GoTo xLnext:
  73.                         End If
  74.                         S2 = Mid(Trim(Rng), InStr(Trim(Rng), "(") + 1)
  75.                         S2 = Mid(S2, 1, Len(S2) - 1)    'ªºªÑ²¼[¥N½X]
  76.                         xFile = xPath & "\" & S2 & "\*.*" '±þ±¼©Ò¦³ÀÉ®×
  77.                         If Dir(xFile) <> "" Then
  78.                             ii = ii - 1
  79.                             Kill xFile
  80.                             xFile = xPath & "\" & S2
  81.                             If Dir(xFile, vbDirectory) <> "" Then RmDir xFile '¸ê®Æ§¨¤]§R°£¤F
  82.                         End If
  83.                     End If
  84.                 End With
  85.                 ii = ii + 1
  86.                 xFile = xPath & "\" & E & "\REVENUE.txt"
  87.                 MkDir_Sub xFile
  88.                 Maketxt xFile, .QueryTables(1)
  89. xLnext:
  90.                 S1 = " " & Sheets(1).QueryTables(1).ResultRange(1)
  91.                 If Val(S1) < 0 Then S1 = " ¬dµL"
  92.                 Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & "  " & E & S1
  93.             Next
  94.         End With
  95.     End With
  96.     Application.ScreenUpdating = True
  97.     Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & " Ok "
  98.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - t, ["MM¤ÀSS¬í"])
  99. End Sub
  100. Private Sub MkDir_Sub(s As String)
  101.     Dim AR, i As Integer, xPath As String
  102.     If Dir(s) = "" Then
  103.         AR = Split(s, "\")
  104.         xPath = AR(0)
  105.         For i = 1 To UBound(AR) - 1
  106.             xPath = xPath & "\" & AR(i)
  107.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  108.         Next
  109.     End If
  110. End Sub
  111. Private Sub Maketxt(xF As String, Q As QueryTable)   '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  112.     Dim fs As Object, E As Range, C As Variant
  113.     Set fs = CreateObject("Scripting.FileSystemObject")
  114.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  115.     For Each E In Q.ResultRange.Rows
  116.         C = Application.Transpose(Application.Transpose(E.Value))
  117.         C = Join(C, vbTab)
  118.         fs.WriteLine C
  119.     Next
  120.     fs.Close
  121. End Sub
½Æ»s¥N½X
¨â­Ó¤ëÀ禬VBA.zip (38.38 KB)

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-27 15:24 ½s¿è

¦^´_ 34# smart3135
  1. Option Explicit
  2. Private Sub Test()
  3.     Dim fs As Object, E As Range, C As Variant
  4.     Set fs = CreateObject("Scripting.FileSystemObject")
  5.     Set fs = fs.CreateTextFile("D:\°]³ø¸ê®Æ\1101\Test.TXT", True)
  6.     '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  7.     '¤å¦rÀɪº¼g¤J¬O
  8.     For Each E In Sheets(1).UsedRange.Columns
  9.         C = E.Value  '-> °}¦C(1 To ¦C¼Æ,1 To øó¼Æ)ªº¤Gºû°}¦C
  10.         C = Application.Transpose(E.Value) '¦]¬°²Ä¤Gºû¥u¦³¤@Äæ,Âà¸m¤@¦¸¥iÅܬ°¤@ºû°}¦C
  11.        '¦pE In UsedRange.rows
  12.        'C = E.Value  '-> °}¦C(1 To ¦C¼Æ,1 To øó¼Æ)ªº¤Gºû°}¦C
  13.        'C = Application.Transpose(Application.Transpose(E.Value)) '²Ä¤Gºû¤£¥u¤@Äæ,©Ò¥HÂà¸m¤G¦¸¤~¥iÅܬ°¤@ºû°}¦C
  14.         C = Join(C, vbTab)
  15.         'Join ¨ç¼Æ ¶Ç¦^¤@­Ó¦r¦ê¡A¸Ó¦r¦ê¬O³z¹L³sµ²¬Y­Ó°}¦C¤¤ªº¦h­Ó¤l¦r¦ê¦Ó«Ø¥ßªº¡C
  16.         'Join ¨ç¼Æ ¨Ï¥Îªº°}¦C¥²¶·¬O¤@ºû°}¦C
  17.         fs.WriteLine C
  18.     Next
  19.     fs.Close
  20. End Sub
½Æ»s¥N½X



¸Ô¬Ýµù¸Ñ¥i©úÁA.

  1. Option Explicit
  2. Sub §ì©u¤ëÀ禬¸ê®Æ()
  3.     Dim E As Integer, URL As String, xPath As String, xFile As String
  4.     Dim i As Integer, ii As Integer, Rng As Range, S1 As String, S2 As String, t As Date
  5.     Dim AR()
  6.     t = Time
  7.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCH/ZCH.DJHTM?A="
  8.     xPath = "D:\°]³ø¸ê®Æ"
  9.     Application.DisplayStatusBar = True
  10.     With ThisWorkbook
  11.         '¨âªÌ¨ú¤@§Y¥i (¿ï¾ÜÀx¦s®æ¸û¤è«K)
  12.         '***'¤£»Ý­nªºªÑ²¼¦p4203¤Ñ¤¯(«á§ì¨ú)¬O¿ù»~ªºªÑ²¼¸¹½X ¸m¤J-> Ar°}¦C
  13.    ' AR = Array(1202, 1420, 1433, 1502, 1518, 1610, 1716, 2346, 2372, 2391, 2513, 2526, 2541, 2802, 2803, 2804, 2806, _
  14.             2813, 2814, 2815, 2817, 2818, 2819, 2821, 2826, 2830, 2839, 2840, 2843, 2844, 2848, 2907, 2909, 4101, 4112, _
  15.             4175, 4201, 4203, 4204, 4301, 4302, 4405, 4407, 4409, 4410, 4411, 4412, 4504, 4505, 4507, 4508, 4509, 4512, _
  16.             4514, 4516, 4517, 4519, 4520, 4521, 4524, 4525, 4531, 4603, 4604, 4605, 4606, 4607, 4608, 4701, 4704, 4705, _
  17.             4708, 4709, 4710, 4713, 4715, 4718, 4901, 4902, 5001, 5003, 5004, 5005, 5012, 5101, 5311, 5319, 5320, 5322, _
  18.             5323, 5327, 5330, 5331, 5334, 5335, 5337, 5341, 5342, 5354, 5357, 5358, 5359, 5360, 5361, 5362, 5363, 5366, _
  19.             5368, 5369, 5374, 5377, 5379, 5380, 5382, 5389, 5391, 5393, 5394, 5396, 5397, 5399, 5404, 5405, 5408, 5409, _
  20.             5411, 5412, 5415, 5416, 5417, 5418, 5419, 5420, 5421, 5422, 5423, 5424, 5427, 5428, 5430, 5431, 5433, 5435, _
  21.             5440, 5444, 5445, 5446, 5447, 5449, 5453, 5456, 5458, 5459, 5461, 5462, 5463, 5470, 5472, 5476, 5477, 5482, _
  22.             5485, 5486, 5495, 5496, 5499, 5509, 5517, 5527, 5606, 5705, 5804, 5805, 5806, 5807, 5809, 5812, 5814, 5815, _
  23.             5854, 6003, 6006, 6019, 6102, 6106, 6401, 6501, 8001, 8003, 8903, 8904, 8912, 8914, 8915, 8918, 8920, 8922, 8939, 9105, 9909)
  24.             
  25.         '***AÄ椤¤£»Ý­nªºªÑ²¼ ¦p4203¤Ñ¤¯(«á§ì¨ú)¸¹½XªºÀx¦s®æ  ¸m¤J-> Ar°}¦C
  26.         Set Rng = .Sheets(2).Range("A:A").SpecialCells(xlCellTypeConstants)
  27.         If Rng Is Nothing Then
  28.             AR = Array()
  29.         ElseIf Rng.Count = 1 Then
  30.             AR = Array(Rng.Value)
  31.         Else
  32.             AR = Application.Transpose(Rng.Value)
  33.             
  34.             '¥ý«e¥X¿ù¬O³o¸Ì¼g¿ù AR = Application.Transpose(Application.Transpose(Rng.Value))
  35.             'Rng.Value=>³æÄæ¤Gºû°}¦C
  36.         End If
  37.         '***************************************************
  38.         .Sheets(2).UsedRange.Offset(, 1).Clear
  39.         Application.ScreenUpdating = False
  40.         Application.StatusBar = " "
  41.         With .Sheets(1)      '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
  42.             If .QueryTables.Count = 0 Then
  43.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  44.                     .Refresh BackgroundQuery:=False
  45.                 End With
  46.             End If
  47.             .Rows(1).Delete
  48.             .Columns(1).Delete
  49.             For E = 1101 To 5000
  50.                 If UBound(Filter(AR, E)) > -1 Then GoTo xLnext
  51.                 'Filter(AR, E)¨ç¼Æ µ¥¦P¨Ï¥ÎFind¤èªk ¦p Set Rng = .Find(S2, lookat:=xlPart) '·j´M:ªÑ²¼¦WºÙ
  52.                 With .QueryTables(1)
  53.                     .Connection = URL & E
  54.                     .PreserveFormatting = True
  55.                     .BackgroundQuery = True
  56.                     .RefreshStyle = xlInsertDeleteCells
  57.                     .SaveData = True
  58.                     .AdjustColumnWidth = True
  59.                     .RefreshPeriod = 0
  60.                     .WebSelectionType = xlSpecifiedTables
  61.                     .WebFormatting = xlWebFormattingNone
  62.                     .WebTables = "3"
  63.                     .WebPreFormattedTextToColumns = True
  64.                     .WebConsecutiveDelimitersAsOne = True
  65.                     .Refresh BackgroundQuery:=False
  66.                     If InStr(.ResultRange(2, 1), "¬dµL") Then      '¬dµL³oÀɪѲ¼
  67.                         Mark_Code E                                '¬dµLªºªÑ²¼ ©ñ¸mAÄd
  68.                         GoTo xLnext
  69.                     End If
  70.                     S1 = .ResultRange(1)                '¶×¤J¸ê®Æªº²Ä1­ÓÀx¦s®æ
  71.                     S2 = Mid(S1, 1, InStr(S1, "(") - 1) 'ªÑ²¼¦WºÙ
  72.                 End With
  73.                
  74.                 With ThisWorkbook.Sheets(2).Range("B:B")
  75.                     Set Rng = .Find(S2, lookat:=xlPart) '·j´M:ªÑ²¼¦WºÙ
  76.                     If Rng Is Nothing Then
  77.                         i = i + 1
  78.                         .Range("A" & i) = S1  'ªÑ²¼¦WºÙ¥N½X
  79.                     Else
  80.                        Mark_Code E '­«½ÆªºªÑ²¼ ©ñ¸mAÄd
  81.                         S2 = Mid(Trim(Rng), InStr(Trim(Rng), "(") + 1)
  82.                         S2 = Mid(S2, 1, Len(S2) - 1)    'ªºªÑ²¼[¥N½X]
  83.                         xFile = xPath & "\" & S2 & "\*.*" '±þ±¼©Ò¦³ÀÉ®×
  84.                         If Dir(xFile) <> "" Then
  85.                             ii = ii - 1
  86.                             Kill xFile
  87.                             xFile = xPath & "\" & S2
  88.                             If Dir(xFile, vbDirectory) <> "" Then RmDir xFile '¸ê®Æ§¨¤]§R°£¤F
  89.                         End If
  90.                     End If
  91.                 End With
  92.                 ii = ii + 1
  93.                 xFile = xPath & "\" & E & "\REVENUE.txt"
  94.                 MkDir_Sub xFile
  95.                 Maketxt xFile, .QueryTables(1)
  96. xLnext:
  97.                 S1 = " " & Sheets(1).QueryTables(1).ResultRange(1)
  98.                 If Val(S1) < 0 Then S1 = " ¬dµL"
  99.                 Application.StatusBar = Application.text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J " & ii & " ¤å¦rÀÉ,  Åª¨ú " & S1 & " ¤¤..."
  100.             Next
  101.         End With
  102.     End With
  103.     Application.ScreenUpdating = True
  104.     Application.StatusBar = Application.text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  105.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.text(Time - t, ["MM¤ÀSS¬í"])
  106.     ThisWorkbook.Save
  107. End Sub
½Æ»s¥N½X
  1. Private Sub Mark_Code(S As Integer)
  2.     With ThisWorkbook.Sheets(2).Range("A:A") '­«½ÆªºªÑ²¼ ©ñ¸mAÄd
  3.         .Cells(Application.Count(.Cells) + 1, "A") = S
  4.         'ªÑ²¼¥N¸¹©ñ¸m AÄd³Ì«á¤@­ÓÀx¦s®æ
  5.         '°õ¦æ¤@¦¸«á,¤U¦¸¦A°õ¦æ [§ì©u¤ëÀ禬¸ê®Æ]µ{¦¡®É,For °j°é¤¤¥i½ð°£³oªÑ²¼¥N¸¹
  6.     End With
  7. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-4-28 07:29 ½s¿è

¦^´_ 35# GBKEE
·PÁÂGBKEEª©¥D³o´X¤Ñ¨Ó¤£Â_ªº±Ð¾É¡A¯uªºÅý§Ú¦bEXCEL VBA¤W¾Ç²ß¨ì«Ü¦h¡A¨ä¥L¤´¦³³\¦h»Ý­nÂ^¨úªº¸ê®Æ¡A¦p¸ê²£­t¶Åªí ²{ª÷¬y¶qªíµ¥¡A³o¨Ç§Ú³£¯à¥Î³o´X¤Ñ¾Ç¨ìªº
µy¥[­×§ï´N¯à§¹¦¨¡A°ß¿W¦³¨âºØ¸ê®Æ¤ñ¸û¯S§O¡A§ÚµLªk¿W¥ß§¹¦¨¡A©Ò¥H¤S­n¦A¨Ó½Ð±ÐGBKEEª©¥D¤F
1.
¤WÂd¤ë¦¨¥æ¸ê°T

¡@¤W­±³sµ²¬°¤WÂd­ÓªÑ¤ë¦¨¥æ¸ê°T¡A§Y¨Ï¿é¤J­ÓªÑ¥N¸¹¡Aºô§}¤´¤£ÅÜ¡A¾Ú¤F¸Ñ¬O¦]¬°ºô­¶¬°POST¡A¨Ã«DGET¡A©Ò¥H¨S¿ìªkÂ^¨ú³øªí
¡@¤£ª¾¹D¦³¨S¦³¿ìªk¤]¥ÎVBA°µ°j°é¨ÓÂ^¨ú¸ê®Æ¡H(¦bEXCEL¶×¤JWEB¸ê®Æ®É¦ü¥G¨Sªkµ¥¨ì¤U­±ªº¦¨¥æ¸ê°Tªí®æ¨Ó¶×¤J¸ê°T)
2.½Ð¥ó¨â­ÓEXCELªþ¥ó¡A³o¬O¦bºô¸ô¤W­±§ä¨ìªº¡A¥D­n¬O­n§ì¤@¦~¤ºªº¶°«O¸ê®Æ¡A¦ý³£¥u¯à¥Î¦Û¦æ¿é¤Jªº¤è¦¡¨Ó¤@­Ó¤@­ÓÂ^¨ú¸ê®Æ
¡@¤£ª¾¹D¦³¨S¦³¿ìªk¤]¥ÎÃþ¦ü³o¨â¤Ñ±z©Ò´£¨Ñªºµ{¦¡½X¨Ó§ì¨ú¶°«O¸ê®Æ¡Aµ²ªG´N¦pªþ¥ó¤¤ªºTXTÀÉ¡A¦A³Â·Ð±z«üÂI¤@¤UÅo¡I·PÁ¡I
   
¶°«O¸ê®Æ


[attach]18178[/attach]

TOP

¦^´_ 35# GBKEE
©êºp Àɮפ£ª¾¹D¬°¤°»ò¤W¶Ç¥¢±Ñ ©Ò¥H¦A¤W¶Ç¤@¦¸
¶°«O¸ê®Æ.zip (74.96 KB)

TOP

¦^´_ 37# smart3135
¥ý¦^ÂФWÂd¤ë¦¨¥æ¸ê°T,¨Æ±¡¦£§¹¦AÄ~Äò¦^ÂЧA
  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php"
  7.      '   .Visible = True   '¤£Åã¥Üie
  8.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¤WÂd¤ë¦¨¥æ¸ê°T()
  12.     Dim E As Range, xPath As String, xFile As String, A As Object, FS As Object, F As Object
  13.     Dim i As Integer, ii As Integer, t As Date, AR(), Rng As Range, r, c, s
  14.     Set FS = CreateObject("Scripting.FileSystemObject")
  15.     Ie_Url = "http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php"
  16.     t = Time
  17.     Application.DisplayStatusBar = True
  18.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  19.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  20.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  21.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  22.     xPath = "D:\°]³ø¸ê®Æ"
  23.     IE_Application    '
  24.     Application.StatusBar = " "
  25.     For Each E In Rng
  26.         With IE
  27.             Set A = .Document.getelementbyid("input_stock_code")
  28.             A.Value = E
  29.             A.ParentNode.submit
  30.             Do While .Busy Or .ReadyState <> 4:    Loop
  31.             Set A = .Document.getelementsbytagname("TABLE")
  32.             xFile = xPath & "\" & E & "\¤WÂd¤ë¦¨¥æ.txt"
  33.             MkDir_Sub xFile
  34.             With FS.CreateTextFile(xFile, True)
  35.                 For i = 1 To A(2).Rows.Length - 1
  36.                     s = ""
  37.                     For c = 0 To A(2).Rows(i).Cells.Length - 1
  38.                         s = s & A(2).Rows(i).Cells(c).innertext & vbTab
  39.                     Next
  40.                     .WriteLine s
  41.                 Next
  42.                 .Close
  43.             End With
  44.             ii = ii + 1
  45.         End With
  46.         Application.StatusBar = Application.text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  47.     Next
  48.     IE.Quit
  49.     Application.StatusBar = Application.text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  50.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.text(Time - t, ["MM¤ÀSS¬í"])
  51.     ThisWorkbook.Save
  52. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 38# GBKEE
GBKEEª©¥D±z¦n¡A³o­Óµ{¦¡½X§Ú¦³¸Õ¤F¡A¥i¥H¦¨¥\¡A¤£¹L¤£ª¾¹D¬°¤°»ò¶]°_¨Ó«D±`ºC¡A¤WÂd¤½¥q²Î­p¦@663®a¡A§Ú±N¥¦¿é¤J¨ìSheets(3)ªºAÄæ
¶]¤@­Ó¤å¦rÀɪº®É¶¡¤j¬ù­n4-5¬í¡A½T©w¦³²M²z¨t²Î¤F¡A¤£¹LÁÙ¬O«D±`ºC
¥t¥~¦³¿ìªk¹³¤§«e±N¶×¤J¸ê®ÆÅã¥Ü¦bEXCEL¥H«K³v¦æ°õ¦æ®É¥i¥H¬Ý¥XEXCEL¦p¦óÅܤơA³Â·Ð±z¤F¡AÁÂÁ¡I
  1. Option Explicit
  2. Dim IE As Object
  3. Sub IE_Application()
  4.     Set IE = CreateObject("InternetExplorer.Application")
  5.     With IE
  6.         .Navigate "http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php"
  7.      '   .Visible = True   '¤£Åã¥Üie
  8.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  9.   End With
  10. End Sub
  11. Sub ¤WÂd¤ë¦¨¥æ¸ê°T()
  12.     Dim E As Range, xPath As String, xFile As String, A As Object, fs As Object, F As Object, IE_URL As String
  13.     Dim i As Integer, ii As Integer, t As Date, AR(), Rng As Range, r, C, S
  14.     Set fs = CreateObject("Scripting.FileSystemObject")
  15.     IE_URL = "http://www.gretai.org.tw/ch/stock/statistics/monthly/st42.php"
  16.     t = Time
  17.     Application.DisplayStatusBar = True
  18.     '½Ð±N¤WÂdªºªÑ²¼¥N¸¹,¦b Sheets(3).Range("A1")©¹¤UKey¤W,°j°é¨Ì³o¸ÌªºªÑ²¼¥N¸¹¶×¤J
  19.     Set Rng = ThisWorkbook.Sheets(3).Range("A:A")
  20.     If Application.Count(Rng) = 0 Then MsgBox "¨S¦³ªÑ²¼¥N¸¹": Exit Sub
  21.     Set Rng = Rng.SpecialCells(xlCellTypeConstants)
  22.     xPath = "G:\°]³ø¸ê®Æ"
  23.     IE_Application    '
  24.     Application.StatusBar = " "
  25.     For Each E In Rng
  26.         With IE
  27.             Set A = .Document.getelementbyid("input_stock_code")
  28.             A.Value = E
  29.             A.ParentNode.submit
  30.             Do While .Busy Or .ReadyState <> 4:    Loop
  31.             Set A = .Document.getelementsbytagname("TABLE")
  32.             xFile = xPath & "\" & E & "\HPM.txt"
  33.             MkDir_Sub xFile
  34.             With fs.CreateTextFile(xFile, True)
  35.                 For i = 1 To A(2).Rows.Length - 1
  36.                     S = ""
  37.                     For C = 0 To A(2).Rows(i).Cells.Length - 1
  38.                         S = S & A(2).Rows(i).Cells(C).innertext & vbTab
  39.                     Next
  40.                     .WriteLine S
  41.                 Next
  42.                 .Close
  43.             End With
  44.             ii = ii + 1
  45.         End With
  46.         Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ"
  47.     Next
  48.     IE.Quit
  49.     Application.StatusBar = Application.Text(Time - t, ["MM¤ÀSS¬í"]) & " ¦@¶×¤J¤WÂd¤ë¦¨¥æ " & ii & " ¤å¦rÀÉ,  Åª¨ú§¹²¦ !! "
  50.     MsgBox "¶×¤J ¤å¦rÀÉ" & ii & " ¶O®É " & Application.Text(Time - t, ["MM¤ÀSS¬í"])
  51.     ThisWorkbook.Save
  52. End Sub
  53. Sub MkDir_Sub(S As String)
  54.     Dim AR, i As Integer, xPath As String
  55.     If Dir(S) = "" Then
  56.         AR = Split(S, "\")
  57.         xPath = AR(0)
  58.         For i = 1 To UBound(AR) - 1
  59.             xPath = xPath & "\" & AR(i)
  60.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  61.         Next
  62.     End If
  63. End Sub
  64. Sub Maketxt(xF As String, Q As QueryTable)   '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  65.     Dim fs As Object, E As Range, C As Variant
  66.     Set fs = CreateObject("Scripting.FileSystemObject")
  67.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  68.     For Each E In Q.ResultRange.Rows
  69.         C = Application.Transpose(Application.Transpose(E.Value))
  70.         C = Join(C, vbTab)
  71.         fs.WriteLine C
  72.     Next
  73.     fs.Close
  74. End Sub
½Æ»s¥N½X

TOP

¦^´_ 39# smart3135
¶]¤@­Ó¤å¦rÀɪº®É¶¡¤j¬ù­n4-5¬í¡A½T©w¦³²M²z¨t²Î¤F¡A¤£¹LÁÙ¬O«D±`ºC ?
¥i¯à¬O¶V¦Ñªºª©¥»³t«×¶V§Ö,¸Õ¸Õ2003ª©¬Ý¬Ý
¥t¥~¦³¿ìªk¹³¤§«e±N¶×¤J¸ê®ÆÅã¥Ü¦bEXCEL¥H«K³v¦æ°õ¦æ®É¥i¥H¬Ý¥XEXCEL¦p¦óÅܤơA¦p¦¹³t«×§óºC¤F.

  1. Option Explicit
  2. Sub ¶°«O¤áªÑÅv_WEB_»s¹Ï()
  3.     Dim WB As Workbook, Rng As Range
  4.     Dim Ar(), A, i As Integer, strDate As String, stkno As String, Qur As String
  5.     With CreateObject("InternetExplorer.Application")
  6.         .Navigate "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
  7.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  8.         Set A = .document.All.tags("option") '¸ê®Æ¤é´Áªº¤º®e
  9.         ReDim Ar(A.Length - 1)
  10.         For i = 0 To A.Length - 1
  11.             Ar(i) = A(i).innerHTML
  12.         Next
  13.         .Quit
  14.     End With
  15.     Set WB = Workbooks.Add
  16.     With WB
  17.         .Sheets(1).Name = "¹Ïªí"
  18.         .Sheets(2).Name = "¸ê®Æ®w"
  19.     End With
  20.     stkno = InputBox("¿é¤JªÑ²¼¥N¸¹", "ªÑ²¼¥N¸¹", 2317)    '
  21.     If stkno = "" Or Len(stkno) <> 4 Or Val(stkno) = 0 Then MsgBox "ªÑ²¼¥N¸¹"
  22.     For i = 0 To UBound(Ar)
  23.         strDate = Ar(i)  '¾É¤J¤ë¥÷
  24.         Qur = "http://www.tdcc.com.tw/smWeb/QryStock.jsp?SCA_DATE=" & strDate & "&SqlMethod=StockNo&StockNo=" & stkno & "&StockName=&sub=%ACd%B8%DF"          '
  25.         With WB.Sheets(3)
  26.             If .QueryTables.Count = 0 Then
  27.                 .QueryTables.Add "URL;" & Qur, .[A1]
  28.             Else
  29.                 .QueryTables(1).Connection = "URL;" & Qur
  30.             End If
  31.             With .QueryTables(1)
  32.                 .WebSelectionType = xlSpecifiedTables
  33.                 .WebFormatting = xlWebFormattingNone
  34.                 .WebTables = "6,7,8"
  35.                 .WebPreFormattedTextToColumns = True
  36.                 .WebConsecutiveDelimitersAsOne = True
  37.                 .WebSingleBlockTextImport = False
  38.                 .WebDisableDateRecognition = False
  39.                 .WebDisableRedirections = False
  40.                 .Refresh BackgroundQuery:=False
  41.                 If Application.Count(.ResultRange) = 0 Then
  42.                     MsgBox "ªÑ²¼¥N¸¹ " & stkno & " ¿ù»~"
  43.                     WB.Close , False
  44.                     Exit Sub
  45.                 End If
  46.                 If i = 0 Then WB.Sheets(2).Cells(2, i + 1).Resize(15) = .ResultRange.Range("B6").Resize(15).Value
  47.                 WB.Sheets(2).Cells(1, i + 2) = Mid(.ResultRange.Range("A3"), 6)
  48.                 WB.Sheets(2).Cells(2, i + 2).Resize(15) = .ResultRange.Range("E6").Resize(15).Value
  49.             End With
  50.         End With
  51.     Next
  52.     With WB
  53.       Set Rng = .Sheets(2).UsedRange
  54.        With .Sheets(1)
  55.             With .ChartObjects.Add(.[B3].Left, .[B3].Top, .[B3].Resize(, 15).Width, .[B3].Resize(25).Height).Chart
  56.                 .ChartType = xlLineMarkers
  57.                 .SetSourceData Rng, xlRows
  58.                 .SeriesCollection(13).AxisGroup = 2
  59.                 .HasTitle = True
  60.                 .ChartTitle.Characters.Text = WB.Sheets(3).[A1]
  61.                 .PlotArea.Interior.ColorIndex = 23
  62.             End With
  63.         End With
  64.         .Activate
  65.     End With
  66. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : µoµÊ®ð¬Oµu¼ÈªºµoºÆ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD