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

[µo°Ý] ¥X²{"¨S¦³³]©wª«¥óÅܼƩÎWith°Ï¶ôÅܼÆ"¿ù»~

µ{¦¡½X¬O­þ¸Ì»yªk¿ù»~,­n¦p¦ó­×¸Ó

½Ð°Ý­n±q¤u§@ªí¦WºÙ¬°WebSht¤¤±N¤U¸üªº¸ê®Æ½Æ»s¦Ü§@¥Îªº¤u§@ªí¤¤¡A¥H¤U»yªk¦p¦ó­×§ï¡AÁÂÁÂ
*¸ê®Æ¥i¨ÌuRngªº­È¨Ó¤U¸ü¸ê®Æ¤U¨Ó¡A¦ý´N¬OÂà¶K¤£¹L¨Ó¡C

Dim lastrow&, TT, DD, SS     
TT = Left(WebSht.[B4], Len(WebSht.[B4]) - 7)   '­n±qWebSht.[B4]¨ú¥X¦r¦ê«e¥b³¡¡A"¥xªd(1101)ªk¤H«ùªÑ©ú²Ó¡A¨ä¤¤¦³")"¡A©Ò¥H¥ý¨ú")"¤§«eªº¥b¬q¦r¦ê¡A¥xªd(1101
DD = Right(TT, Len(uRng))   '¦A±qDD¦r¦ê¨ú¥X­n¥Îªº¦r¦ê
SS = Left(TT, Len(TT) - Len(uRng) - 1)  '¨ú¥X¨ä¥b¬q¡A¥xªd
lastrow = WebSht.[b13].End(xlDown).Row  'ºâ¸ê®Æ¦C
If DD <> uRng Then Exit Sub  '¤ñ¹ïDD¦r¦ê©MuRngªº­È¦³¬Ûµ¥¶Ü
uRng(2) = SS
uRng(2, -1).Resize(lastrow - 7, 1) = WebSht.[b13].Resize(lastrow - 7, 1).Value '¤é´Á¸ê®ÆÄæ
uRng(2, 1).Resize(lastrow - 7, 10) = WebSht.[c12].Resize(lastrow - 7, 10).Value '¤T¤jªk¤H¸ê®Æ

End Sub

TOP

¥»©«³Ì«á¥Ñ owen06 ©ó 2014-5-15 09:46 ½s¿è

¦^´_ 1# a510684

¤u§@ªí¦WºÙ«e­±­n¥[sheets("xxx")
¦p¡GTT = Left(sheets("WebSht").[B4], Len(sheets("WebSht").[B4]) - 7)

¥t¥~¥i¥H½Ð°Ý§Aªºurng¥Nªíªº¬O¤°»ò¶Ü¡H

TOP

¥t¥~¥i¥H½Ð°Ý§Aªºurng¥Nªíªº¬O¤°»ò¶Ü¡H
urng¬O¥NªíÀx¦s®æ¤¤ªº¥N¸¹¡B
Dim WebSht As Worksheet, xURL$, GetInfo$, uRng As Range, ErrNo, LL, RR, CC, TT

Sub §ó·s¥þ³¡()
Dim y&, TM, i&
If MsgBox("­n¥þ³¡§ó·s¶Ü¡H¡@", 4 + 32 + 256) = vbNo Then Exit Sub
TM = Time:  ErrNo = 0: [A1] = "00:00:00"
[L5:ZZ600].ClearContents: [K6:K600].ClearContents: [L4].Select
Application.ScreenUpdating = False
y = [zz4].End(xlToLeft).Column: If y < 12 Then Exit Sub
For i = 12 To y Step 10
    If ErrNo > 0 Then GoTo 102
    Set uRng = Cells(4, i)
    uRng.Select
    If uRng <> "" Then Call §ó·sWeb: Call ¸ü¤J¼Æ¾Ú
    [A1] = Format(Time - TM, "hh:mm:ss")
Next i
Application.ScreenUpdating = True

102: Beep
End Sub

Sub ¸ü¤J¼Æ¾Ú()
Dim lastrow&, TT, DD, SS
TT = Left(WebSht.[B4], Len(WebSht.[B4]) - 7)
DD = Right(TT, Len(uRng))
SS = Left(TT, Len(TT) - Len(uRng) - 1)
lastrow = WebSht.[b13].End(xlDown).Row
If DD <> uRng Then Exit Sub
uRng(2) = SS
uRng(2, -1).Resize(lastrow - 7, 1) = WebSht.[b13].Resize(lastrow - 7, 1).Value '¤é´Á¸ê®ÆÄæ
uRng(2, 1).Resize(lastrow - 7, 10) = WebSht.[c12].Resize(lastrow - 7, 10).Value '¤T¤jªk¤H¸ê®Æ

End Sub

Sub §ó·sWeb()
Dim DY1, DY2, DY3, DY4
Application.EnableCancelKey = xlErrorHandler
DY1 = Year(Date) - 1
DY2 = Year(Date)
DY3 = Month(Date)
DY4 = Day(Date)

Set WebSht = Sheets("Web")
WebSht.Cells.Clear
ErrNo = 0
On Error GoTo 101
xURL = "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl.djhtm?a=" & uRng & "&c=" & DY1 & "-" & DY3 & "-" & DY4 & "&d=" & DY2 & "-" & DY3 & "-" & DY4 & ""

With WebSht.QueryTables.Add(Connection:=xURL, Destination:=WebSht.[A1])
        .AdjustColumnWidth = False
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .Refresh BackgroundQuery:=False
        .Delete
End With
Exit Sub
101: ErrNo = Err.Number
End Sub

TOP

­è­è¸Õ¤@¤UÁÙ¬O¤£¦æ±Nweb¤u§@ªíªº¸ê®Æ¶K¨ì§@¥Îªº¬d¸ßªí¤¤¡A½ÐÀ°¦£¡A§Ú¸Õ¤F¦n¤[¡A³£¬d¤£¥X¨Ó

TOP

Sub ¸ü¤J¼Æ¾Ú()

Dim Ln As Long, TT, DD, SS As String

Ln = Worksheets("Web").Range("B2000").End(xlUp).Row
TT = Left(Sheets("Web").[B4], Len(Sheets("Web").[B4]) - 7)
SS = Replace(TT, "(", "")
DD = Left(SS, Len(SS) - Len(uRng))  °õ¦æ®É¿ù»~Åã¥Ü¬°uRng¨S¦³³]©wª«¥óÅܼơA¦ý«e­±¤£¾A³]©w¹L¤F¡A¦³¤j¤j­n¨ó§UÀ°¦£¶Ü?ÁÂÁÂ
If Right(SS, Len(uRng)) <> uRng Then Exit Sub
uRng(2) = SS
uRng(2, -1).Resize(Ln - 6, 1).Value = Sheets("Web").[B13].Resize(Ln - 6, 1).Value '¤é´Á¸ê®ÆÄæ
uRng(2, 1).Resize(Ln - 6, 10).Value = Sheets("Web").[c12].Resize(Ln - 6, 10).Value '¤T¤jªk¤H¸ê®Æ

End Sub

TOP

¦^´_ 5# a510684


  ½Ð°Ý¤è«K§âÀɮפW¶Ç¤W¨Ó¬Ý¬Ý¶Ü¡H¦]¬°³o­ÓÀɮצü¥G®¼½ÆÂøªº¡A
  ¦³Àɮרӹê¦a¾Þ§@¤@¤UÀ³¸Ó¤ñ¸û¦n¡C

TOP

[µo°Ý] ¥X²{"¨S¦³³]©wª«¥óÅܼƩÎWith°Ï¶ôÅܼÆ"¿ù»~

¥X²{"¨S¦³³]©wª«¥óÅܼƩÎWith°Ï¶ôÅܼÆ"¿ù»~¦b¬õ¦â¦r¦a¤è¡A½Ð¦U¦ì¥ý¶iÀ°¦£

Dim WebSht As Worksheet, xURL$, GetInfo$, ErrNo, TT As String, DD As String, SS As String, uRng As Range

Sub §ó·s¥þ³¡()
Dim y&, TM, i&
If MsgBox("­n¥þ³¡§ó·s¶Ü¡H¡@", 4 + 32 + 256) = vbNo Then Exit Sub
TM = Time:  ErrNo = 0: [A1] = "00:00:00"
[L5:ZZ600].ClearContents: [K6:K600].ClearContents: [L4].Select
y = [zz4].End(xlToLeft).Column: If y < 12 Then Exit Sub
For i = 12 To y Step 10
    If ErrNo > 0 Then GoTo 102
    Set uRng = Cells(4, i)
    uRng.Select
    If uRng <> "" Then Call §ó·sWeb: Call ¸ü¤J¼Æ¾Ú
    [A1] = Format(Time - TM, "hh:mm:ss")
Next i
102: Beep
End Sub

Sub ¸ü¤J¼Æ¾Ú()

Dim Ln As Long

Ln = Worksheets("Web").Range("B2000").End(xlUp).Row
TT = Left(Sheets("Web").[B4], Len(Sheets("Web").[B4]) - 7)
SS = Replace(TT, "(", "")
DD = Left(SS, Len(SS) - Len(uRng))
If Right(SS, Len(uRng)) <> uRng Then Exit Sub
uRng(2) = DD
uRng(2, -1).Resize(Ln - 6, 1) = Sheets("Web").[B13].Resize(Ln - 6, 1).Value '¤é´Á¸ê®ÆÄæ
uRng(2, 1).Resize(Ln - 6, 10) = Sheets("Web").[c12].Resize(Ln - 6, 10).Value '¤T¤jªk¤H¸ê®Æ

End Sub

Sub §ó·sWeb()
Dim DY1, DY2, DY3, DY4
Application.EnableCancelKey = xlErrorHandler
DY1 = Year(Date) - 1
DY2 = Year(Date)
DY3 = Month(Date)
DY4 = Day(Date)

Set WebSht = Sheets("Web")
WebSht.Cells.Clear
ErrNo = 0
On Error GoTo 101
xURL = "URL;http://jsjustweb.jihsun.com.tw/z/zc/zcl/zcl.djhtm?a=" & uRng & "&c=" & DY1 & "-" & DY3 & "-" & DY4 & "&d=" & DY2 & "-" & DY3 & "-" & DY4 & ""

With WebSht.QueryTables.Add(Connection:=xURL, Destination:=WebSht.[A1])
        .AdjustColumnWidth = False
        .WebSelectionType = xlAllTables
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .Refresh BackgroundQuery:=False
        .Delete
End With
Exit Sub
101: ErrNo = Err.Number
End Sub

¥»©«³Ì«á¥Ñ GBKEE ©ó 2014-5-16 15:52 ½s¿è

¦^´_ 7# a510684
  1. Dim WebSht As Worksheet, xURL$, GetInfo$, ErrNo, TT As String, DD As String, SS As String, uRng As Range
  2. Sub §ó·s¥þ³¡()
  3. Dim y&, TM, i&
  4. If MsgBox("­n¥þ³¡§ó·s¶Ü¡H¡@", 4 + 32 + 256) = vbNo Then Exit Sub
  5. TM = Time:  ErrNo = 0: [A1] = "00:00:00"
  6. [L5:ZZ600].ClearContents: [K6:K600].ClearContents: [L4].Select
  7. y = [zz4].End(xlToLeft).Column: If y < 12 Then MsgBox "y < 12":   Exit Sub
  8. For i = 12 To y Step 10
  9.     If ErrNo > 0 Then GoTo 102
  10.     Set uRng = Cells(4, i)
  11.     uRng.Select
  12.     If uRng <> "" Then Call §ó·sWeb: Call ¸ü¤J¼Æ¾Ú
  13.     [A1] = Format(Time - TM, "hh:mm:ss")
  14. Next i
  15. 102: Beep
  16. End Sub


  17. Sub ¸ü¤J¼Æ¾Ú()  
  18.     Dim Ln As Long
  19.     If uRng Is Nothing Then MsgBox "uRng : ¨S¦³³]©wª«¥óÅܼƩÎWith°Ï¶ôÅܼÆ"
  20.     Ln = Worksheets("Web").Range("B2000").End(xlUp).Row
  21.     TT = Left(Sheets("Web").[B4], Len(Sheets("Web").[B4]) - 7)
  22.     SS = Replace(TT, "(", "")
  23.     DD = Left(SS, Len(SS) - Len(uRng))
  24.     If Right(SS, Len(uRng)) <> uRng Then Exit Sub
  25.     uRng(2) = DD
  26.     uRng(2, -1).Resize(Ln - 6, 1) = Sheets("Web").[B13].Resize(Ln - 6, 1).Value '¤é´Á¸ê®ÆÄæ
  27.     uRng(2, 1).Resize(Ln - 6, 10) = Sheets("Web").[c12].Resize(Ln - 6, 10).Value '¤T¤jªk¤H¸ê®Æ
  28. End Sub
½Æ»s¥N½X
·P®¦ªº¤ß......(¦b³Â»¶®a±Ú°Q½×°Ï.¥Î¤ß¾Ç²ß·|¦³¶i¨Bªº)
¦ý¸ê·½µL­­,«á´©¦³­­,  ¤@¤Ñ1¤¸ªºÃÙ§U,¤H¤H¦³¯à¤O.

TOP

        ÀR«ä¦Û¦b : ¤Ó¶§¥ú¤j¡B¤÷¥À®¦¤j¡B§g¤l¶q¤j¡A¤p¤H®ð¤j¡C
ªð¦^¦Cªí ¤W¤@¥DÃD