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

[µo°Ý] ³o­Ó±M®×ªºµ{¦¡½X¥²¶·§ó·s¤~¯à¥Î©ó64¦ì¤¸¨t²Î?

[µo°Ý] ³o­Ó±M®×ªºµ{¦¡½X¥²¶·§ó·s¤~¯à¥Î©ó64¦ì¤¸¨t²Î?

¦b°õ¦æ¦¹µ{¦¡½X®É¡A¥X²{"³o­Ó±M®×ªºµ{¦¡½X¥²¶·§ó·s¤~¯à¥Î©ó64¦ì¤¸¨t²Î¡A½ÐÀ˵ø©M§ó·s Declare³¯­z¦¡¡AµM«á¥HPtrSafeÄÝ©Ê¥[¥H¼Ð°O"
½Ð°Ý­n¦p¦ó¸Ñ¨M?
3Q

­ìµ{¦¡½X¦p¤U:
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim uMode$, xDicA As Object, xDicB As Object

Sub ·n¼ú()
Dim x%, y%, xR As Range, k%, Km%, KK%
If uMode = "Start" Then Exit Sub
'----------------------------------------
x = [·n¼ú!A65536].End(xlUp).Row
If x < 2 Then MsgBox "¡°¿ù»~¡IµLªk¨ú±o¡e¼ú«~¡f¶µ¥Ø¡I": Exit Sub
Set xDicA = CreateObject("Scripting.Dictionary")
For Each xR In [·n¼ú!A2].Resize(x - 1)
    Km = Val(xR(1, 4)) - Val(xR(1, 5))
    If Km > 0 Then
       For k = 1 To Km
           KK = KK + 1: xDicA(KK) = xR.Row
       Next k
    End If
Next
If xDicA.Count = 0 Then MsgBox "¡°¡e¼ú«~¡f¤w©â¨ú§¹²¦¡I": Exit Sub
'------------------------------------------------
KK = 0
y = [¤H­û¦W³æ!A65536].End(xlUp).Row
If y < 2 Then MsgBox "¡°¿ù»~¡IµLªk¨ú±o¡e¤H­û¦W³æ¡f¶µ¥Ø¡I": Exit Sub
Set xDicB = CreateObject("Scripting.Dictionary")
For Each xR In [¤H­û¦W³æ!A2].Resize(y - 1)
    If xR(1, 3) = "" Then KK = KK + 1: xDicB(KK) = xR.Row
Next
If xDicB.Count = 0 Then MsgBox "¡°©Ò¦³¡e¤H­û¡f¤w©â¼ú§¹²¦¡I": Exit Sub
'----------------------------------------
uMode = "Start"
Call ±Ò°Ê
End Sub

Sub °±¤î()
uMode = "Stop"
[G5,G9,G11] = ""
End Sub

Sub ½T©w()
Dim AA%, BB%
If uMode <> "Start" Then Exit Sub
uMode = "Stop"
Randomize
AA = xDicA(Int(Rnd * xDicA.Count) + 1)
With Sheets("·n¼ú")
    .Cells(AA, 5) = .Cells(AA, 5) + 1
    .[G9] = .Cells(AA, 2)
    .[G11] = .Cells(AA, 3)
End With
'-------------------------------------
BB = xDicB(Int(Rnd * xDicB.Count) + 1)
With Sheets("¤H­û¦W³æ")
    [·n¼ú!G5] = .Cells(BB, 2)
    .Cells(BB, 3) = [·n¼ú!G9]
    .Cells(BB, 4) = [·n¼ú!G11]
End With
ThisWorkbook.Save
Beep
End Sub

Sub ±Ò°Ê()
Dim i%, j%
For i = 1 To 600
    If uMode <> "Start" Then Exit Sub
    For j = 1 To 5
        [G5,G9,G11] = Mid(Rnd, 3, 6) & Mid(Rnd, 3, 6)
         Sleep 2
    Next j
    DoEvents
Next i
Application.OnTime Now + TimeValue("00:00:01"), "±Ò°Ê"
End Sub

Sub ²M°£CDÄæ()
[¤H­û¦W³æ!C2:D6000].ClearContents
End Sub

¥»©«³Ì«á¥Ñ q1a2z5 ©ó 2017-2-5 22:30 ½s¿è

³o­Ó¬O±qºô¸ô¤U¸üªºÂ²©ö·n¼ú¾¹¡A¦ý¬O¤£¯à°õ¦æ¡A¤@«ö¤U´N·|¥X²{¦¹°T®§¡A¥Îªº2010ª©¥»64¦ì¤¸ªº.

20130203a02(²©ö·n¼ú¾¹).rar (15.61 KB)

TOP

¾Ç®üµL²P_¤£®¢¤U°Ý

TOP

¦^´_ 2# q1a2z5
­×§ï¦¨¡G
  1. #If VBA7 And Win64 Then
  2. Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
  3. #Else
  4. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
  5. #End If
½Æ»s¥N½X
´N¥i¥H°õ¦æ¤F¡C

TOP

        ÀR«ä¦Û¦b : ¤H¥Í¤£¤@©w²y²y¬O¦n²y¡A¦ý¬O¦³¾ú½mªº±j¥´ªÌ¡AÀH®É³£¥i¥H´§´Î¡C
ªð¦^¦Cªí ¤W¤@¥DÃD