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

[µo°Ý] ¤U¸ü¤¤Â_°ÝÃD

[µo°Ý] ¤U¸ü¤¤Â_°ÝÃD

¤j®a¦n:

      ·Q½Ð°Ý­Ó°ÝÃD¡A¦]¬°§Ú¤U¸ü·|¤¤Â_¡A¦p¹Ï©Ò¥Ü¡C
      ¤£ª¾¹D¦³¨S¦³¿ìªk¥[­Óµ{¦¡½X¡A¥i¥Hª½±µ§PÂ_¡A¦Ó¤£³y¦¨¤U¸ü¹Lµ{¦³µLªk¶}±Òªºª¬ªp¡C
     ÁÂÁ¡C

°ÝÃD.jpg (14.98 KB)

°ÝÃD.jpg

Desktop.rar (276.97 KB)

¥»©«³Ì«á¥Ñ luhpro ©ó 2013-11-16 09:33 ½s¿è

¦^´_ 1# spermbank
³oºØ±¡§Î³Ì±`¨£ªº³B²z¤è¦¡´N¬O¥[¤W¿ù»~³B²z.

¦]¬°ªþÀɦb§Úªº Excel 2003 °õ¦æ®É·|¤@ª½¦³¿ù»~,
©Ò¥H§Ú¦Û¤v¥t¥~°µ¤F¤@­ÓÀÉ®×,
§A¥i¥H°Ñ·ÓµÛ­×§ï§Aªºµ{¦¡.
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.   Dim i%, j&
  3.   Dim bErr As Boolean
  4.   
  5.   On Error GoTo errGet
  6.   
  7.   bErr = False
  8.   For i = 1 To 6
  9.     j = j + i
  10.     If i = 3 Then Err.Raise 1004 ' ¦¹¦æ¼ÒÀÀºô­¶Åª¨ú¥¢±Ñ,µo¥Í 1004 ¿ù»~
  11.     If Not bErr Then
  12.       MsgBox "°õ¦æŪ¨úºô­¶ªº°Ê§@, i = 3 ®É·|¼ÒÀÀµo¥Í¿ù»~, ¥Ø«e i =" & i
  13.     Else
  14.       MsgBox "ºô­¶Åª¨ú¥¢±Ñ«áªº³B²z,¨Ò : ­«Åª, µ¥´X¬í..., i = 3 ®É·|¼ÒÀÀµo¥Í¿ù»~, ¥Ø«e i =" & i
  15.       bErr = False
  16.     End If
  17.   Next
  18.   
  19. On Error GoTo 0
  20. Exit Sub
  21.   
  22. errGet:
  23.   If Err.Number = 1004 Then bErr = True
  24.   Resume Next
  25. End Sub
½Æ»s¥N½X
Desktop-a.zip (7.26 KB)

TOP

¦^´_ 2# luhpro

±z¦n:
      ¤£ª¾¹D¦p¦ó¥[¤J±zµ¹§Úªºµ{¦¡½X¡A¦ý¬O§ó·sªº®É­Ô·|¦A.Refresh³o¤@¦æ¥X²{¿ù»~¡C
¥i¥H¦A½Ð¦h«ü±Ð¤@¨Ç¶Ü? ÁÂÁ¡C

Sub ¤U¸ü°ò¥»¸ê®Æ()


    Range("P" & 23).Formula = "§ó·s¶}©l..." '.§ï
    Application.ScreenUpdating = False

    Sheets("DDE").Select
    x = Application.WorksheetFunction.CountA(Range("A:A")) 'Äæ¦ì¦³­È½d³ò­pºâ
   
    With ThisWorkbook


    For Each a In .Sheets("DDE").Range("A" & 1418, "A" & x - 1).SpecialCells(xlCellTypeConstants).Offset(1) '³]©w½d³ò  '==========­n´î1============

    §ó·s¸ê®Æ a '°õ¦æ12Àɮקó·s

    Workbooks("­·ÀIµû¦ô.xlsx").Sheets(Array("IS", "ISQ", "BS", "BSQ", "BASIC", "YrPrice", "FR", "CFS", "ISQT")).Copy '½Æ»s¤u§@ªí

    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Base\" & CStr(a) & ".xlsx" '¥t¦s·sÀÉ

    ÃöÀÉ

    Next

    End With
   
    Sheets("DDE").Select
    Range("P" & 23).Formula = "§ó·sµ²§ô" '.§ï
    Application.ScreenUpdating = True
End Sub

Sub §ó·s¸ê®Æ(a)

    Dim Sh As Worksheet, MyURL$, MyQy As QueryTable

    With ThisWorkbook

    fd = .Path & "\°ò¥»­±\­·ÀIµû¦ô\"

    fs = Dir(fd & "*.xlsx")

    Do Until fs = ""

    With Workbooks.Open(fd & fs)
   
    For Each Sh In .Sheets

        With Sh

        If .QueryTables.Count > 0 Then

            Set MyQy = .QueryTables(1)

            With .QueryTables(1)

            MyURL = .Connection

            If InStr(MyURL, "StockID") > 0 Then

                k = Val(Split(MyURL, "=")(UBound(Split(MyURL, "="))))

                Else

                k = Val(Split(MyURL, "_")(1))

            End If

            MyURL = Replace(MyURL, k, a)

            .Connection = MyURL '§ó§ï¬d¸ß

            .BackgroundQuery = False '¹õ«e§ó·s
            
            .Refresh '§ó·s

            End With

        End If

        End With

    Next

    End With

    fs = Dir()

    Loop

    End With

End Sub

Sub ÃöÀÉ()

    For Each w In Windows

    If w.Caption <> ThisWorkbook.Name Then w.Close 1

    Next

End Sub

TOP

¥»©«³Ì«á¥Ñ luhpro ©ó 2013-11-16 22:50 ½s¿è

¦^´_ 3# spermbank
¥H¤Uµ{¦¡©ñ¦b Module ¤º :
  1. Public bStop As Boolean
½Æ»s¥N½X
Sub ¤U¸ü°ò¥»¸ê®Æ()
  .
  .
  .
    §ó·s¸ê®Æ a '°õ¦æ12Àɮקó·s
   If bStop Then Exit For
  .
  .
  .
End Sub


Sub §ó·s¸ê®Æ(a)
  Dim Sh As Worksheet, MyURL$, MyQy As QueryTable
  Dim iI%, lJ&, OpenForms  
  .
  .
  .
  On Error GoTo errGet
              .Refresh '§ó·s
  On Error GoTo 0
            End With
        End If
        End With
    Next
    End With
    fs = Dir()
    Loop
    End With
  Exit Sub
   
: errGet
  If Err.Number = 1004 Then
    For lJ = 1 To 5000 ' Ū¨úºô­¶¥¢±Ñ®É, µ¥¤@¬q®É¶¡¦A­«Åª¤@¦¸, ­Y³sÄò5¦¸¥¢±Ñ,«h¤¤¤îŪ¨ú.
      If lJ Mod 1000 = 0 Then OpenForms = DoEvents ' ¨C¹j¤@¬q®É¶¡±N±±¨îÅvÁÙµ¹Windows³B²z¨ä¥Lµ{¦¡ªº§@·~.
    Next
    iI = iI + 1
    If iI > 10 Then
      bStop = True
      MsgBox "Ū¨úºô­¶¥¢±Ñ, µ{¦¡²×¤î..."
      Exit Sub
    End If
    Resume
  Else
    Resume Next
  End If

End Sub

TOP

¦^´_ 4# luhpro

     §¹¥þ¥i¥H¶]¡A¤£·|¦³¤¤Â_²{¶H¡A¯u¬O¤Q¤À·PÁÂ^^

TOP

        ÀR«ä¦Û¦b : ¤H­n¦Û·R¡A¤~¯à·R´¶¤Ñ¤Uªº¤H¡C
ªð¦^¦Cªí ¤W¤@¥DÃD