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

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

¦³¨S¦³¤èªk¥i¥H¥ÎEXCEL VAB§ì¨ú¤W¥«Âd©Ò¦³­ÓªÑªº¸ê°T?

·Q½Ð°Ý¦U¦ì¥ý¶i¡A¤p§Ì³Ìªñ¦b¾ÇEXCEL VBA¡A·Q§Q¥ÎEXCEL VBA¤U¸ü­ÓªÑªº¤@¨Ç¸ê°T¡A¦p¦U©u¦U¦~ªº·l¯qªí¡B¸ê²£­t¶Åªí¡B²{ª÷¬y¶qªí¡B¤ëÀ禬¡B¦~«×ªÑ§Qµ¥µ¥¸ê®Æ
¥Ø«e¬O¦³¼g¥X¤@­ÓEXCEL VBA¯à§ì¨ú³æ¿W­ÓªÑªº¸ê°T¡A¦ý¦pªG·Q­n§ó´«¨ä¥L­ÓªÑ¡A´N¥²¶·±N³o­ÓÀɮ׽ƻs¥t¦s¦¨¥t¤@­ÓÀɮסA¦A¥´¶}Àɮ׶i¨ìvisual basic½s½r¾¹±N
¸Ì­±ªº­ÓªÑ¥N¸¹¥H¨ú¥Nªº¤è¦¡Åܧó¡A¦pªG­n³o¼Ë¤@­Ó¤@­Ó½Æ»s§¹¦¨¤W¥«Âd©Ò¦³ªº­ÓªÑexcelÀ³¸Ó¬O«Ü¨S¦³®Ä²vªº¡A¤£ª¾¹D¦³¨S¦³¤èªk¯à¤@¦¸¤U¸ü«Ü¦h­ÓªÑªº¸ê®Æ©O¡H
ªþ¤W§Ú¦Û¤v¼gªºEXCEL VBA¡AÁٽЦU¦ì¤j¤jÀ°¦£¸Ñ´b¡A·PÁ¡I
test.rar (235.84 KB)

TOP

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

½Ð°Ý¤@¤U¦U¦ì¥ý¶i¡A³o¬O§Ú±q¬Yºô¯¸¶×¤JEXCELªºµ{¦¡½X¡A¤£ª¾¹D¯à¤£¯à¨Ï¥Î°j°é©ÎÅܼƪº¤è¦¡¨ú¨ä¥L­ÓªÑ¬Û¦Pªº°]³ø¡H
¤]´N¬Oµ{¦¡½X¤¤ªº2330¥i¥H¥Î°j°é©ÎÅܼƨÓÅܧó¶Ü¡HÀµ½Ð¦U¦ìVBA°ª¤â«üÂI¡AÁÂÁ¡I
https://www.cathayholdings.com/securities/exclude_AL/market.aspx?btn=1-00-00&st=2330
  1. Sub §ì©u·l¯qªí¸ê®Æ()
  2.     With ActiveSheet.QueryTables.Add(Connection:= _
  3.         "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A=2330", Destination _
  4.         :=Range("$A$1"))
  5.         .Name = "ZCQ.DJHTM?A=2330"
  6.         .FieldNames = True
  7.         .RowNumbers = False
  8.         .FillAdjacentFormulas = False
  9.         .PreserveFormatting = True
  10.         .RefreshOnFileOpen = False
  11.         .BackgroundQuery = True
  12.         .RefreshStyle = xlInsertDeleteCells
  13.         .SavePassword = False
  14.         .SaveData = True
  15.         .AdjustColumnWidth = True
  16.         .RefreshPeriod = 0
  17.         .WebSelectionType = xlSpecifiedTables
  18.         .WebFormatting = xlWebFormattingNone
  19.         .WebTables = "3"
  20.         .WebPreFormattedTextToColumns = True
  21.         .WebConsecutiveDelimitersAsOne = True
  22.         .WebSingleBlockTextImport = False
  23.         .WebDisableDateRecognition = False
  24.         .WebDisableRedirections = False
  25.         .Refresh BackgroundQuery:=False
  26.     End With
  27. Sub End
½Æ»s¥N½X

¦^´_ 2# smart3135
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub §ì©u·l¯qªí¸ê®Æ()
  3.     Dim Rng As Range, AR(), URL As String, E As Variant
  4.     For E = Sheets.Count To 2 Step -1
  5.         Sheets(E).Delete   '¤u§@ªí§R°£
  6.     Next
  7.     AR = Array(2303, 2485, 2030)
  8.     Sheets(1).Range("A1:A3") = Application.WorksheetFunction.Transpose(AR)
  9.     Set Rng = Sheets(1).Range("A1:A3")
  10.     For Each E In Rng   '°j°é Àx¦s®æ
  11.     ' For Each E In AR  '°j°é ¤]¥i¥H¥Î°}¦C
  12.         With Sheets.Add(, Sheets(1))  '·s¼W¤u§@ªí
  13.             .Name = E
  14.             URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A=" & E
  15.             With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  16.                 .Name = "ZCQ.DJHTM?A=" & E
  17.                 .PreserveFormatting = True
  18.                 .BackgroundQuery = True
  19.                 .RefreshStyle = xlInsertDeleteCells
  20.                 .SaveData = True
  21.                 .AdjustColumnWidth = True
  22.                 .RefreshPeriod = 0
  23.                 .WebSelectionType = xlSpecifiedTables
  24.                 .WebFormatting = xlWebFormattingNone
  25.                 .WebTables = "3"
  26.                 .WebPreFormattedTextToColumns = True
  27.                 .WebConsecutiveDelimitersAsOne = True
  28.                 .Refresh BackgroundQuery:=False
  29.             End With
  30.         End With
  31.     Next
  32. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 3# GBKEE
·PÁÂGBKEE¤j¤j«üÂI·s¤â¡A¥Ø«e¤H¦b¤W¯Z¡Aµ¥¤U¯Z¦A¨Ó´ú¸Õµ²ªG¡A¤]·|¸ÕµÛ¤F¸Ñ¨ä¤¤ªº»yªk¡A¦³°ÝÃD¦A½Ð±z¦h¦h«üÂI¡A¦A¦¸·PÁ¡I

TOP

¦^´_ 3# GBKEE
·PÁÂGBKEEª©¥Dªº¤À¨É¡A³o­Ó¯uªº¬O¤Ó´Î¤F¡AÁöµM§Ú¸Ì­±«Ü¦hªºµ{¦¡½X©M»yªk§ÚÁÙ¬O¤@ª¾¥b¸Ñ¡A¦ý½T¹ê¬O¦³±µªñ§Ú·Q­n¼g¥Xªºµ²ªG
¥t¥~¦³­Ó°ÝÃD½Ð±Ð¤@¤U¡A´N¬OAR = Array(2303, 2485, 2030)¥u¯à¤@­Ó¤@­Ó¥N¸¹¥[¤J¡A¯à§_¼g¦¨¥Î¤@­Ó°Ï¶¡½d³ò¨Ó³]©w
¨Ò¦p1101-2330¤§¶¡©Ò¦³²Å¦XªºªÑ²¼¥N¸¹¡A¨ÃÅýVBA¦Û¦æ§P©w«DªÑ²¼¥N½Xªº¼Æ¦r´N¤£¬O§ì¸ê®Æ¡A¦A½Ð«üÂI¡A·PÁ¡I

TOP

¦^´_ 5# smart3135
  1. Option Explicit
  2. Sub §ì©u·l¯qªí¸ê®Æ()
  3.     Dim E As Integer
  4.     Application.DisplayAlerts = False  '°±¤î¨t²ÎªºÄµ§i´£¥Ü
  5.     For E = 1101 To 2330
  6.         With Sheets.Add(, Sheets(1))   '·s¼W¤u§@ªí
  7.             .Name = E
  8.             URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A=" & E
  9.             With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  10.                 .Name = "ZCQ.DJHTM?A=" & E
  11.                 .PreserveFormatting = True
  12.                 .BackgroundQuery = True
  13.                 .RefreshStyle = xlInsertDeleteCells
  14.                 .SaveData = True
  15.                 .AdjustColumnWidth = True
  16.                 .RefreshPeriod = 0
  17.                 .WebSelectionType = xlSpecifiedTables
  18.                 .WebFormatting = xlWebFormattingNone
  19.                 .WebTables = "3"
  20.                 .WebPreFormattedTextToColumns = True
  21.                 .WebConsecutiveDelimitersAsOne = True
  22.                 .Refresh BackgroundQuery:=False
  23.             End With
  24.             
  25.             If .[A1] = -E Then  '³oºô­¶¦pªÑ²¼¥N½X¿ù»~·|¶Ç¦^­t¸¹.
  26.                 Stop            'STOP ¬Oµ¹§A¦^¨ì¤u§@ªíÅçÃÒ¥Î,¥i§R±¼³oµ{¦¡½X
  27.                 ActiveSheet.Delete
  28.             End If
  29.         End With
  30.     Next
  31.     Application.DisplayAlerts = True   'µ{¦¡µ²³t:«ì´_¨t²ÎªºÄµ§i´£¥Ü
  32. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 6# GBKEE
·PÁª©¥Dªº¦^µª¡A¥t¥~·Q¦A½Ð±Ð¤@­Ó°ÝÃD¡A¤£ª¾¹DVBA¦³¨S¦³¿ìªk±N§Ú§ì¨ú¤U¨Óªº¸ê®Æ¶K¨ì°O¨Æ¥»¦A¦Û°Ê¦sÀÉ
¤§«e¦³À|¸Õ¹L¡A¦ýEXCEL VBA¦ü¥G¨Sªk±±¨îEXCEL¥H¥~ªº³nÅé©Îµ{¦¡¡A«á¨Ó§Ú¬O¨Ï¥ÎEXCEL¥t¦s·sÀɤ¤ªº¦s¦¨
¤å¦rÀÉ(tab¦r¤¸¤À¹j)(*txt)¡A³o¼Ë¥i¥H¦s¦¨¤å¦rÀÉ¡A¤£¹L¤£ª¾¹D¦sÀɪº¸ô®|¸ê®Æ§¨¦³¨S¦³¿ì¥Î¥ý«e°µ¥X°j°éªºÅܼÆE¨Ó«ü©w
¨Ò¦p¡G§Ú·Q±N§ì¨ú¤U¨Óªº1101©u·l¯qªí¥ý©ñ¨ìsheet(1)¡A¦A¥t¦s¦¨XYZ.TXT¡A¦sÀɸô®|¬OC:\E\XYZ.TXT
¨ä¤¤E´N¬O§Ú§Æ±æ¯àÀHµÛ§ì¨úªºªÑ²¼¥N¸¹¤@°_ÅܧóªºÅܼơA¤]´N¬O­Y§ì¨úªº¸ê®Æ¬O1101¡A¨º»ò¦sÀɸô®|´N¬OC:\1101\XYZ.TXT
¦sÀɸô®|¸ê®Æ§¨­YVBA¦³¿ìªk§Q¥Îµ{¦¡½X·s¼W·íµM³Ì¦n¡A¦pªG¨S¿ìªkªº¸Ü§Ú¥i¥H¦Û¤v«Ø¥ß¡A§¹¦¨«á±N1101©u·l¯qªíªº¤u§@ªí§R°£¡A
¦A·s¼W¤U¤@­Ó1102©u·l¯qªíªº¤u§@ªí¡A¦A­«ÂФW­zªº°Ê§@¡A°ÝÃD¦³ÂI¦h¡A§Æ±æ§Úªí¹Fªº·N«ä¤£·|¤ÓÃøÀ´¡A¦A³Â·Ð¤j¤jÅo¡I·PÁ¡I

TOP

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

¦^´_ 7# smart3135
¸Õ¸Õ¬Ý
  1. Option Explicit
  2. Sub §ì©u·l¯qªí¸ê®Æ()
  3.     Dim E As Integer, URL As String, xPath As String
  4.     URL = "URL;https://djinfo.cathaysec.com.tw/Z/ZC/ZCQ/ZCQ.DJHTM?A="
  5.     xPath = "C:\©u·l¯qªí"
  6.     '¦sÀɸô®|¬OC:\E\XYZ.TXT, «Øij§ï¬° C:\©u·l¯qªí\1101.txt
  7.     With ThisWorkbook
  8.        ' If .Sheets.Count = 1 Then .Sheets.Add  '°t¦XŪ¨útxtÀɨì¤u§@ªí®É¥²¶·¦³2±i¤u§@ªí
  9.         With .Sheets(1)   '¬¡­¶Ã¯ªº²Ä 1 ±i¤u§@ªí
  10.             If .QueryTables.Count = 0 Then
  11.                 With .QueryTables.Add(Connection:=URL, Destination:=.Range("$A$1"))
  12.                     .Refresh BackgroundQuery:=False
  13.                 End With
  14.             End If
  15.             For E = 1101 To 2330
  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 & "\" & E & ".TXT", .QueryTables(1)
  34.                     'Redalltxt xPath & "\" & E & ".TXT"  'Ū¨útxtÀɨì¤u§@ªí
  35.                 End If
  36.             Next
  37.         End With
  38.     End With
  39. End Sub
  40. Sub Maketxt(xF As String, Q As QueryTable)   '±N¶×¤J¸ê®Æ¦s¤J«ü©wªºtxt
  41.     Dim fs As Object, E As Range, C As Variant
  42.     Set fs = CreateObject("Scripting.FileSystemObject")
  43.     Set fs = fs.CreateTextFile(xF, True)  '³Ð¨£¤@­ÓÀÉ®×,¦pÀɮצs¦b¥iÂл\±¼
  44.     For Each E In Q.ResultRange.Rows
  45.         C = Application.Transpose(Application.Transpose(E.Value))
  46.         C = Join(C, vbTab)
  47.         fs.WriteLine C
  48.     Next
  49.     fs.Close
  50. End Sub
  51. Sub Redalltxt(xF As String)   '
  52.     Dim fs As Object, E, D As New DataObject
  53.     'DataObject ª«¥ó ¦b¶i¦æÂà´«°Ê§@®É¡A°µ¬°®æ¦¡¤Æ¤å¦r¸ê®Æªº¼È¦s°Ï°ì¡C¨ä¤]¥i¥H¼È¦s©MÀx¦s¦b DataObject ªº¤å¦r¤ù¬q¬ÛÃöªº®æ¦¡¡C
  54.     '«Å§i Dim D As New DataObject '¶·¦b¤u¨ã-> ³]©w¤Þ¥Î¶µ¥Ø¥[¤J ·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library ,±M®× ¥[¤J¤@ªí³æ§Y¥i
  55.     Set fs = CreateObject("Scripting.FileSystemObject")
  56.     Set fs = fs.OpenTextFile(xF, 1)
  57.      E = fs.readall
  58.     fs.Close
  59.     With D
  60.         .SetText E
  61.         .PutInClipboard
  62.         With Sheets(2)
  63.             .UsedRange.Clear
  64.             .Activate
  65.             .Range("A1").Select
  66.             .PasteSpecial Format:="Unicode ¤å¦r"
  67.             .Cells.Font.Size = 12
  68.             .Cells.Font.Bold = False
  69.             .Cells.EntireColumn.AutoFit
  70.         End With
  71.     End With
  72. End Sub
  73. Sub Set_FormDLL()   '·s¼W¤Þ¥Î Microsoft Forms 2.0 Object Library
  74.     On Error Resume Next
  75.     FormDLL = "FM20.DLL"
  76.     ThisWorkbook.VBProject.References.AddFromFile "C:\windows\system32\" & FormDLL
  77. '2003ª©ªº¥Ø¿ý¬° C:\windows\system32\ ,§A»Ý­×§ï¦¹¥Ø¿ý
  78. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

¦^´_ 8# GBKEE
WOW¡AGBKEEª©¥D¯uªº¤Ó¯«¤F¡A¸Ì­±ªº»yªk¦³¦n¦hÁ٬ݤ£À´¡A¥Ø«e¥¿¥Î³v¦æ°õ¦æ¨Ó¤F¸Ñ¡AºCºC®ø¤Æ§l¦¬¡A«Ü·PÁ±zªº¦^µª
¤£¹L¥i¯à§Ú«e­±ªí¹Fªº¤£¬O«Ü²M·¡¡A´N±zªºµ{¦¡½X¨Ó»¡¡A²£¥Íªºµ²ªG·|Åܦ¨¦bC:\©u·l¯qªí\1101.txt¡A1102.txt¡A1103.txt
¤]´N¬O¦bC¼Ñ©u·l¯qªí¸ê®Æ§¨¤U·|²£¥Í¤@­Ó­Ó·Ó­ÓªÑ¥N½X©R¦WªºtxtÀÉ¡A¦ý§Ú§Æ±æ²£¥Íªºµ²ªG¬OC:\©u·l¯qªí\1101\ISQ.txt
C:\©u·l¯qªí\1102\ISQ.txt¡AC:\©u·l¯qªí\1103\ISQ.txt¡A¤]´N¬OtxtÀɦW¬O©T©wªº¡A¥Ñ§Ú¦Û¤v«ü©wÀɦW¡A³o¸Ì¬O¥ý¹w³]ISQ.txt
¦Ó¯àÀHµÛ­ÓªÑ¥N½XÅܰʪº¬O¸ê®Æ§¨¦WºÙ¡A¸ê®Æ§¨­YµLªk¥ÑVBA²£¥Í§Ú¥i¥H¦Û¦æ«Ø¥ß¡A¤£ª¾¹DVBA¦³¨S¦³¿ìªk°µ¨ì³o¼Ëªºµ²ªG
¦A¦¸Àµ½Ð¤j¤j«üÂI°g¬z¡A·PÁ¡I

   

TOP

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

¦^´_ 9# smart3135
  1. Option Explicit
  2. Sub Ex()
  3.     MkDir_Sub "D:\Test\©u·l¯qªí\1103\ISQ.txt"
  4. End Sub
  5. Sub MkDir_Sub(S As String)
  6.     Dim AR, i As Integer, xPath As String
  7.     If Dir(S) = "" Then
  8.         AR = Split(S, "\")
  9.         '¦pS°Ñ¼Æ©Ò±µ¦¬¦r¦ê="D:\MYSUB\ABC\1101.TXT
  10.         'Split¨ç¼Æ±NS¥H"\"¤À³Î¬°°}¦C
  11.         'AR(0) = "D:"
  12.         'AR(1) = "MYSUB"
  13.         'AR(2) = "ABC"
  14.         'AR(3) = "1101.TXT"
  15.         'UBound(AR)¶Ç¦^AR°}¦Cªº¤W­­¤¸¯À¯Á¤Þ­È,3
  16.         xPath = AR(0)
  17.         For i = 1 To UBound(AR) - 1
  18.             xPath = xPath & "\" & AR(i)
  19.             If Dir(xPath, vbDirectory) = "" Then MkDir xPath
  20.             'MkDir : ³Ð«Ø¥Ø¿ý
  21.         Next
  22.     End If
  23. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¶¢¤HµL¼Ö½ì¡A¦£¤HµL¬O«D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD