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

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

¦^´_ 8# GBKEE
¦A¸É¥R¤@¤U¡A·í§ì¨ú¸ê®Æªººô¯¸¬dµL¸Ó¸ê®Æ®É´N·|¥X¿ù¡A¦]¬°§Úªº³sµ²¬O§ì·l¯q©uªí(¦X¨Ö°]³ø)¡A¦Ó·í­ÓªÑµL¦X¨Ö°]³ø¥i§ì¨ú¸ê®Æ®É´N·|¥X¿ù
¦ý¬d¸ß·l¯qªí(©uªí)¬O¦³¸ê®Æªº¡A¤£ª¾VBAµ{¦¡½X¯à¤£¯à°µ¨ì·í¥D­nºô­¶¸ê®Æ[·l¯q©uªí(¦X¨Ö°]³ø)]§ì¤£¨ì®É´N¥h§ì¦¸­nºô­¶¸ê®Æ[·l¯qªí(©uªí)]
1339-2.jpg
2014-4-24 10:08


·l¯q©uªí(¦X¨Ö°]³ø0
1339-1.jpg
2014-4-24 10:09


·l¯qªí(©uªí)
1339-3.jpg
2014-4-24 10:10

TOP

¥»©«³Ì«á¥Ñ smart3135 ©ó 2014-4-24 13:43 ½s¿è
¦^´_  smart3135
¸Õ¸Õ¬Ý
GBKEE µoªí©ó 2014-4-24 09:07


©I¡Iªá¤FÂI®É¶¡ºCºC¬ã¨s¤@­Ó­Óµ{¦¡½Xªº·N«ä¤Î»yªk¡A¦A±NGBKEEª©¤j´£¨Ñªºµ{¦¡½Xµy°µ­×§ï¡A²×©ó§¹¦¨¤F¡I²{¦b¥u­n°õ¦æVBA´N¯à±N§Ú­nªºISQ.TXTÀÉ©ñ¦b
°j°éÅܼÆE©Ò²£¥Íªº¸ê®Æ§¨¤U¡A¤]´N¬OC:\©u·l¯qªí\1101\¡BC:\©u·l¯qªí\1102\¡A°ß¤@­nª`·Nªº¬OC¼Ñ¤Uªº©u·l¯qªí¸ê®Æ§¨¤@©w­n¦Û¤v¥ý«Ø¥ß¡A§_«h°õ¦æµ{¦¡®É·|¥X¿ù
²{¦b´N¥u³Ñ¤U¤W¤@½g´£¥Xªº°ÝÃD¡G·í§ì¨úºô­¶¸ê®Æ®É­YµL¸ê®Æ­n¦p¦ó¸õ¹L©Î¥h§ì¨ú¦³¸ê®Æªººô­¶¥HÁקK¥X¿ù¡A¦A½ÐGBKEE¤j¤j«üÂIÅo¡I·P®¦¡I
  1. Option Explicit
  2. Sub §ì©u·l¯qªí¸ê®Æ()
  3.     Dim E As Integer, URL As String, xPath As String, ISQ As String
  4.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A="
  5.     For E = 1101 To 2330
  6.         xPath = "C:\" & "©u·l¯qªí" & "\" & E & "\"
  7.         '¦sÀɸô®|¬OC:\E\XYZ.TXT, «Øij§ï¬° C:\©u·l¯qªí\1101.txt
  8.         With ThisWorkbook
  9.            ' If .Sheets.Count = 1 Then .Sheets.Add  '°t¦XŪ¨útxtÀɨì¤u§@ªí®É¥²¶·¦³2±i¤u§@ªí
  10.             With .Sheets(1)   '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
  11.                 If .QueryTables.Count = 0 Then
  12.                     With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  13.                         .Refresh BackgroundQuery:=False
  14.                     End With
  15.                 End If
  16.                     With .QueryTables(1)
  17.                         .Connection = URL & E
  18.                         .PreserveFormatting = True
  19.                         .BackgroundQuery = True
  20.                         .RefreshStyle = xlInsertDeleteCells
  21.                         .SaveData = True
  22.                         .AdjustColumnWidth = True
  23.                         .RefreshPeriod = 0
  24.                         .WebSelectionType = xlSpecifiedTables
  25.                         .WebFormatting = xlWebFormattingNone
  26.                         .WebTables = "3"
  27.                         .WebPreFormattedTextToColumns = True
  28.                         .WebConsecutiveDelimitersAsOne = True
  29.                         .Refresh BackgroundQuery:=False
  30.                     End With
  31.                     If .[A1] <> -E Then  '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
  32.                         If Dir(xPath, vbDirectory) = "" Then MkDir xPath '¥Ø¿ý¤£¦s¦b«h·s¼x¼W¦¹¥Ø¿ý
  33.                         Maketxt xPath & "ISQ.TXT", .QueryTables(1)
  34.                         'Redalltxt xPath & "\" & E & ".TXT"  'Ū¨útxtÀɨì¤u§@ªí
  35.                     End If
  36.                
  37.             End With
  38.         End With
  39.     Next
  40. End Sub
  41. Sub Maketxt(xF As String, Q As QueryTable)   '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  42.     Dim fs As Object, E As Range, C As Variant
  43.     Set fs = CreateObject("Scripting.FileSystemObject")
  44.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  45.     For Each E In Q.ResultRange.Rows
  46.         C = Application.Transpose(Application.Transpose(E.Value))
  47.         C = Join(C, vbTab)
  48.         fs.WriteLine C
  49.     Next
  50.     fs.Close
  51. End Sub
  52. Sub Redalltxt(xF As String)   '
  53.     Dim fs As Object, E, D As New DataObject
  54.     'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
  55.     '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
  56.     Set fs = CreateObject("Scripting.FileSystemObject")
  57.     Set fs = fs.OpenTextFile(xF, 1)
  58.      E = fs.readall
  59.     fs.Close
  60.     With D
  61.         .SetText E
  62.         .PutInClipboard
  63.         With Sheets(2)
  64.             .UsedRange.Clear
  65.             .Activate
  66.             .Range("A1").Select
  67.             .PasteSpecial Format:="Unicode ¤å¦r"
  68.             .Cells.Font.Size = 12
  69.             .Cells.Font.Bold = False
  70.             .Cells.EntireColumn.AutoFit
  71.         End With
  72.     End With
  73. End Sub
  74. Sub Set_FormDLL()   '·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library
  75.     On Error Resume Next
  76.     FormDLL = "FM20.DLL"
  77.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
  78. '2003ª©ªº¥Ø¿ý¬° C:\windows\system32\ ,§A»Ý­×§ï¦¹¥Ø¿ý
  79. End Sub
½Æ»s¥N½X

TOP

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

¦^´_ 12# smart3135
  1. Option Explicit
  2. Sub §ì©u·l¯qªí¸ê®Æ()
  3.     Dim E As Integer, URL As String, xPath As String, xFile As String
  4.     Dim Msg As Boolean
  5.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A="
  6.     xPath = "C:\©u·l¯qªí"
  7.     With ThisWorkbook
  8.         With .Sheets(1)      '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
  9.             If .QueryTables.Count = 0 Then
  10.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  11.                     .Refresh BackgroundQuery:=False
  12.                 End With
  13.             End If
  14.             For E = 1339 To 2330
  15. ER:
  16.                 With .QueryTables(1)
  17.                     If Msg = False Then
  18.                       .Connection = URL & E
  19.                     ElseIf Msg Then
  20.                                   'https://djinfo.cathaysec.com.tw/z/zc/zcq/zcq0_1339_ACC.djhtm   ·l¯qªí(²Ö­p©uªí)
  21.                        .Connection = "URL;https://djinfo.cathaysec.com.tw/z/zc/zcq/zcq0_" & E & "_ACC.djhtm"
  22.                     End If
  23.                     .PreserveFormatting = True
  24.                     .BackgroundQuery = True
  25.                     .RefreshStyle = xlInsertDeleteCells
  26.                     .SaveData = True
  27.                     .AdjustColumnWidth = True
  28.                     .RefreshPeriod = 0
  29.                     .WebSelectionType = xlSpecifiedTables
  30.                     .WebFormatting = xlWebFormattingNone
  31.                     .WebTables = "3"
  32.                     .WebPreFormattedTextToColumns = True
  33.                     .WebConsecutiveDelimitersAsOne = True
  34.                     .Refresh BackgroundQuery:=False
  35.                 End With
  36.                 If InStr(.[A3], "¬dµL") Then Msg = True: GoTo ER
  37.                 If InStr(.[A3], "­ÓªÑ¥N½X¿ù»~") = 0 Then '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
  38.                      xFile = xPath & "\" & E & "\ISQ.txt"
  39.                     MkDir_Sub xFile       '10#ªºµ{¦¡ 'C¼Ñ¤Uªº©u·l¯qªí¸ê®Æ§¨¤£»Ý¥ý«Ø¥ß
  40.                     Maketxt xFile, .QueryTables(1)
  41.                 End If
  42.                 Msg = False
  43.             Next
  44.         End With
  45.     End With
  46. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 13# GBKEE
©êºp¡AGBKEE¤j¤j¡A¹Ï¤ù¤¤ªº»yªk¤@¶}©l´N°õ¦æ¿ù»~¡A¤£ª¾¹D¬O§_»yªk¦³»~¡A³o¬q»yªk¯uªº¬Ý¤£À´¡A¦A½Ð±z±Ð¾É¤@¤U¡A·PÁ¡I
555555555.jpg
2014-4-24 19:54

TOP

¦^´_ 14# smart3135
µù¸Ñ¦³¦b¬Ý¶Ü? ­n½Æ»s²Ä10#ªº MkDir_Sub µ{¦¡¨ì¼Ò²Õ¤W.
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 15# GBKEE
Sorry¡A­è­èµù¸Ñ¬O¦³¬Ý¤F¡A¤£¹L¤£¤ÓÀ´·N«ä¡A­ì¨Ó¬O­n§â¥ý«e#10ªºµ{¦¡½X©ñ¨ì¼Ò²Õ¤¤¡A¤§«á´N¸Ñ¨M¤F
VBA°õ¦æ¤j¶q°j°é«á¦ü¥G·|¦û¥Î°O¾ÐÅ骺ªÅ¶¡¡A¾É­P°j°éªº°õ¦æ¨ì«á­±·|¶V¨Ó¶VºC¡A¤£ª¾¹D§ÚªºÆ[©À¹ï¤£¹ï
¥Ø«e¥¿¦b·j¯Á¦³ÃöÄÀ©ñ°O¾ÐÅ骺¤å³¹¡A¦A¦¸¤j¤O·PÁÂGBKEE¤j¤j¤£¹½¨ä·Ðªº«ü¾É^^:handshake

TOP

¥»©«³Ì«á¥Ñ smart3135 ©ó 2014-4-25 05:25 ½s¿è

¦^´_ 8# GBKEE
GBKEEª©¥D±z¦n¡A¬Q¤Ñ±z´£¨ì±NEXCEL¶×¤Jªº¸ê®Æ¦s¤J«ü©wªºtxt¡A§Ú¥Î³v¦æ°õ¦æ¡Aµo²{¥¦¬O¥Î°j°éªº¤è¦¡¡A±NEXCEL¶×¤Jªº¸ê®Æ¤@¦C¤@¦Cªº¦s¤J«ü©wªºtxt¤¤
ª½¨ì¹J¨ìªÅ¥Õ¸ê®Æ§Y°±¤î°j°é¤£¦A¦s¤J¡A·Q½Ð°Ý­Y­n±NEXCEL¶×¤Jªº¸ê®Æ¦s¤J¨ìtxt¤¤¡A¬O¥u¯à¥Î³oºØ¤@¦C¤@¦C¦s¤Jªº¤è¦¡¶Ü¡H
³oºØ¤è¦¡À³¸Ó´N¹³¬OÂI¿ïEXCELªº²Ä¤@¦C¡AµM«á«ö·Æ¹«¥kÁä½Æ»s(©ÎCtrl+C)¡A¦A¶K¨ìtxt¤¤ªº²Ä¤@¦C¡A²Ä¤G¦C¸ê®Æ´N´«¨ìEXCEL²Ä¤G¦C­«ÂФ@¼Ëªº°Ê§@
ª½¨ì¨S¦³¸ê®Æ¯à¶K¤W¬°¤î¡A¤£ª¾¹D§Ú³o¼Ë¸ÑŪ¹ï¤£¹ï¡A¥D­n¬O·Q½Ð°Ý¡A¦³¨S¦³¤èªk¯àÅýEXCEL¸ê®Æ¡A¹³ÂI¿ïEXCEL¥ª¤W¨¤ªº¥þ¿ï(Cells.select)¡AµM«áª½±µ¥þ³¡½Æ»s¡A
¦A¥þ³¡ª½±µ¶K¨ìtxt¤¤¡A³o¼ËÀ³¸Ó´N¤£¥Î¨«°j°é¡A¤@¦¸¶K¤W§Y¥i¡A¦]¬°¤£²M·¡VBA¦³¨S¦³»yªk¯à°µ¨ì³o¼Ë¡A©Ò¥H­n¦A½Ð±zÀ°¦£¸Ñ´b¤@¤UÅo¡I·PÁ¡I
  1. Sub Maketxt(xF As String, Q As QueryTable)   '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  2.     Dim fs As Object, E As Range, C As Variant
  3.     Set fs = CreateObject("Scripting.FileSystemObject")
  4.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  5.     For Each E In Q.ResultRange.Rows
  6.         C = Application.Transpose(Application.Transpose(E.Value))
  7.         C = Join(C, vbTab)
  8.         fs.WriteLine C
  9.     Next
  10.     fs.Close
  11. End Sub
½Æ»s¥N½X

TOP

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

¦^´_ 17# smart3135
10# ªºµ{¦¡½X¬Ý¤£À´,¤w¥[µù»¡©ú¤F.
·|¥X²{°O¾ÐÅ餣¨¬ªºµøµ¡,¦bXP,°O¾ÐÅé1GB,2003ª©,°õ¦æ5¤ÀÄÁ¤º¥i§¹¦¨,ÂX¥R§Aªº°O¾ÐÅé¸Õ¸Õ¬Ý
¥þ³¡ª½±µ¶K¨ìtxt¤¤¡A³o¼ËÀ³¸Ó´N¤£¥Î¨«°j°é,ºCºC¦A¬ã¨s.
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¥»©«³Ì«á¥Ñ smart3135 ©ó 2014-4-25 06:22 ½s¿è

¦^´_ 18# GBKEE
¤£¦n·N«ä¡A¤Sµo²{¤@­Ó°ÝÃD­n¨Ó½Ð±Ð±z¤F¡A¥ý«e¦³¦V±z½Ð±Ð·í·l¯q©uªí(¦X¨Ö°]³ø)ªº¸ê®Æ§ì¤£¨ì®É¡A´N¥h§ì·l¯qªí(©uªí)¡A¨ä¤¤ªºÃöÁä¦r¬O¦bA3Àx¦s®æ
Áä¤J¬dµL¡A«h²Ä¤@­Ó³sµ²§ì¤£¨ì®É´N·|¥h§ì²Ä¤G­Ó³sµ²ªº¸ê®Æ¡A¦ý§Ú¦b¸ÕµÛ§ì·l¯q¦~ªí®É¡A·í­ÓªÑ¤£¦s¦b®É¡A¤£¬O¥X²{­ÓªÑ¥N½X¿ù»~¡A¦Ó¬O¦bA3¥X²{¬dµL·l¯q¦~ªí(¦X¨Ö³øªí)
³o®É·|¥h§ì²Ä¤G­Ó³sµ²¡Aµ²ªG¤@¼Ë·|¦bA3¥X²{¬dµL·l¯q¦~ªí¡A³o®É´NµLªk¸õ¥X°j°é¡AÅܦ¨¤@ª½¦b°j°é¸Ì¥´Âà¤F¡A¨â­ÓµLªk§ì¨ú¸ê®Æªº³sµ²³£¦bA3¥X²{¬Û¦PªºÃöÁä¦r
¥H­Pµ{¦¡½XµLªk°Ï§O¡A´N«ùÄò¨«µLºÉ°j°é¡A¤£ª¾¹D³o­Ó°ÝÃD¦³¨S¦³¿ìªk¸Ñ¨M¡H¸ê®Æ¤@¦¸¶K¤Wªº¤è¦¡§Ú·|¦AºCºCtry¡A·PÁ±z­@¤ßªº¦^µª¡AÁÂÁ¡I
  1. Option Explicit
  2. Sub §ì¦~·l¯qªí¸ê®Æ()
  3.     Dim E As Integer, URL As String, xPath As String, xFile As String
  4.     Dim Msg As Boolean
  5.     URL = "URL;https://djinfo.cathaysec.com.tw/z/zc/zcq/zcqa/zcqa.djhtm?A="
  6.     xPath = "G:\°]³ø¸ê®Æ"
  7.     With ThisWorkbook
  8.         With .Sheets(1)      '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
  9.             If .QueryTables.Count = 0 Then
  10.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  11.                     .Refresh BackgroundQuery:=False
  12.                 End With
  13.             End If
  14.             For E = 1341 To 2000
  15. ER:
  16.                 With .QueryTables(1)
  17.                     If Msg = False Then
  18.                       .Connection = URL & E
  19.                     ElseIf Msg Then
  20.                     'https://djinfo.cathaysec.com.tw/z/zc/zcq/zcqa/zcqa0_1339_ACC.djhtm   ·l¯qªí(¦~ªí)
  21.                        .Connection = "URL;https://djinfo.cathaysec.com.tw/z/zc/zcq/zcqa/zcqa0_" & E & "_ACC.djhtm"
  22.                     End If
  23.                     .PreserveFormatting = True
  24.                     .BackgroundQuery = True
  25.                     .RefreshStyle = xlInsertDeleteCells
  26.                     .SaveData = True
  27.                     .AdjustColumnWidth = True
  28.                     .RefreshPeriod = 0
  29.                     .WebSelectionType = xlSpecifiedTables
  30.                     .WebFormatting = xlWebFormattingNone
  31.                     .WebTables = "3"
  32.                     .WebPreFormattedTextToColumns = True
  33.                     .WebConsecutiveDelimitersAsOne = True
  34.                     .Refresh BackgroundQuery:=False
  35.                 End With
  36.                 If InStr(.[A3], "¬dµL") Then Msg = True: GoTo ER
  37.                 If InStr(.[A3], "­ÓªÑ¥N½X¿ù»~") = False Then '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
  38.                      xFile = xPath & "\" & E & "\IS.txt"
  39.                     MkDir_Sub xFile       '10#ªºµ{¦¡ 'C¼Ñ¤Uªº©u·l¯qªí¸ê®Æ§¨¤£»Ý¥ý«Ø¥ß
  40.                     Maketxt xFile, .QueryTables(1)
  41.                 End If
  42.                 Msg = False
  43.             Next
  44.         End With
  45.     End With
  46. End Sub
½Æ»s¥N½X

TOP

¦^´_ 18# GBKEE
©êºp¡A­è­è¸ÕµÛ¸ÕµÛ¡A¦n¹³¦¨¥\¤F¡A³y¦¨±zªº§xÂZ¡A¯u¤£¦n·N«ä¡I

TOP

        ÀR«ä¦Û¦b : ­n¤ñ½Ö§ó¨ü½Ö¡D¤£­n¤ñ½Ö§ó©È½Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD