4

マルチスレッド解析を取得するために VBA でコードを作成するにはどうすればよいですか?

このチュートリアルを見てきましたが、うまくいきません。

私は 10000 のサイトを持っており、各サイトは列 A の 1 つの行にあります。タグ間の情報を解析し、各サイトの index.php からタグを<div></div>取得し、結果を列 B の各行に保存するには、少なくとも 10 の同時スレッドが必要です。<a>rel="external"

4

3 に答える 3

8

VBA ではマルチスレッドを使用できますが、ネイティブでは使用できません。ただし、VBA でマルチスレッドを実現する方法はいくつかあります。

  1. C#.NET COM/dlls - C#.NET で COM/dll を作成します。これにより、スレッドを自由に作成し、他の外部ライブラリのように VBA から参照できます。これに関する私の投稿を参照してください。VBA 内からの C# メソッドの参照に関するこの Stackoverflow の投稿も参照してください: EXCEL VBA 内で C# dll を使用する
  2. VBscript ワーカー スレッド- アルゴリズムを必要な数の VBscript に分割し、VBA から実行します。VBscript は、VBA を介して自動的に作成できます。これに関する私の投稿を参照してください：ここ
  3. VBA ワーカー スレッド- スレッドが必要な回数だけ Excel ワークブックをコピーし、VBA から VBscript を介してそれらを実行します。VBscript は、VBA を介して自動的に作成できます。これに関する私の投稿を参照してください：ここ

これらすべてのアプローチを分析し、長所と短所、およびいくつかのパフォーマンス メトリックを比較しました。ここで投稿全体を見つけることができます：

http://analystcave.com/excel-multithreading-vba-vs-vbscript-vs-c-net/

于 2014-11-16T01:04:00.617 に答える
7

@Siddharth Rout がコメントで指摘しているように、答えはノーです。しかし、これを少し拡張すると、バックグラウンドで実行され、マルチスレッドを有効にするように見えるメソッドでさえ、マルチスレッドは許可されません。

これの良い例はApplication.OnTimeです。これにより、将来のある時点でプロシージャを実行できます。

このメソッドを使用すると、事前に設定された時間が経過してプロシージャが呼び出されるまで、ユーザーはワークブックの編集を続けることができます。一見すると、これを巧妙に使用すると、複数のコード フラグメントを同時に実行できるように見えるかもしれません。次のフラグメントを検討してください。

For a = 1 To 500000000
Next a

私のマシンの For...Next ループは、完了するまでに約 5 秒かかります。これを考慮してください：

Application.OnTime Now + TimeValue("00:00:1"), "ztest2"
For a = 1 To 500000000
Next a

これにより、Application.OnTime ステートメントが読み取られてから 1 秒後に "ztest2" が呼び出されます。For...Next ループには 5 秒かかり、.OnTime は 1 秒後に実行されるため、For...Next ループの途中で "ztest2" が呼び出される可能性があります。つまり、疑似マルチスレッドです。

まあ、これは起こりません。上記のコードを実行するとわかるように、Application.OnTime は For...Next ループが完了するまで辛抱強く待つ必要があります。

于 2013-10-03T13:27:39.887 に答える
0

真のマルチスレッド、つまり異なるコアでスレッドを同時に並行して実行することはできませんが、複数のスレッドからのアクションをキューに入れることでマルチスレッド コードをシミュレートできます。

例: subA を 600 ミリ秒 (ミリ秒) ごとに 1 回実行し、SubB を 200 ミリ秒ごとに 1 回実行します。順序は次のようになります: SubB、SubB、SubB、SubA、SubB、SubB、SubB、SubA、SubB、SubB、...

'Create a new class Tick_Timer to get access to NumTicks which counts ticks in
'milliseconds.
'While not used for this script, this class can also be used for a millisecond
'StartTimer/EndTimer which I included below.
'It can also be used to create a pause, similar to wait but in ms, that can
'allow other code to run while paused which I prefer over the sleep function.
'Sleep doesn't allow interruptions and hogs processor time. 
'The pause function would be placed in a module and works similar to the
'Queue Timer loop which I'll explain below.
Private StartTick As Long
Private Declare Function GetTickCount Lib "kernel32" () As Long

Public Function GetNumTicks() As Long
    GetNumTicks = GetTickCount
End Function

'Timer functions(not used in this script)
Public Sub StartTimer()
    StartTick = GetTickCount
End Sub

Public Function EndTimer() As Long
    EndTimer = (GetTickCount - StartTick)
End Function

モジュールで、いくつかのグローバル変数を宣言しました。多くの人がグローバル変数の使用を悪い習慣と考えていることは承知しています。ローカル変数と混同しないように、グローバルには常にプレフィックスを使用します。

この場合、キュー内の最初のタイマーの前に実行する必要がある新しいスレッドがいつでも呼び出される可能性があるため、グローバル変数には引数を使用するよりも利点があります。

グローバル変数はどこでも変更できるため、キューの更新を動的に行うことができます。また、ほぼすべてのサブルーチンが何らかの方法でキューを使用することを考慮してください。そのため、グローバルを使用する方が理にかなっています。

Public ST_TimerName As String 'Subroutine Name that is run as a new thread.

'Two strings are used to store the queue. 
'The first stores only the start times of each thread in tickcounts. 
'This allows me to sort the queue more easily.
'The second string (ST_TimerQ) contains TimerDelay:TimerName and is created at the
'same time as the sorted launch times so they are kept synchronous.
Public ST_EndTickQ As String  'queue string: trigger times in TickCounts.
Public ST_TimerQ As String    'queue string: TimerDelay:TimerName 

'New class that allows you to get the current Tick Count.
Public ST_Timer As Tick_Timer 'timer that accesses to Tick Count

Sub SetTimer(ByVal TimerName As String, ByVal TimerDelay As Long)
'Starts a new thread called TimerName which executes after TimerDelay(ms)
'TimerName: Name of subroutine that is to be activated.
'TimerDelay:
'-value for single execution after abs(-value) delay,
'+value Repeats TimerName with a period of TimerDelay.
'0 stops repeating TimerName.
    Dim EndTick As Long
    Dim TimerDat As String

    Set ST_Timer = New Tick_Timer
    EndTick = ST_Timer.GetNumTicks + Abs(TimerDelay)

    If TimerDelay = 0 Then
    'Stops TimerName
        RemoveFromQ TimerName
    Else
    'Insert to Queue, single or repeated is determined by +/-delay stored in TimerDat.
        TimerDat = TimerDelay & ":" & TimerName
        Call AddToQ(TimerDat, EndTick)
    End If
End Sub 'SetTimer

Sub SetTimerQLoop()
'All threads are continuously merged into an action queue with a sequential
'insertion sort.
'A simple loop containing only the DoEvents function(allows other VBA code to run) 
'loops until the the next thread in the queue needs to start.
'An outer loop runs through the queue until EOQ.
    Dim EndTick As Long
    Dim EOQ As Boolean

    On Error GoTo ErrHandler
    EOQ = False
    'SetTimer Queue Loop
    Do While Not (EOQ)
        'Delay Loop, DoEvents allows other vba scripts to run during delay.
        Do
            DoEvents
        Loop Until ST_Timer.GetNumTicks >= Val(ST_EndTickQ)

        Application.Run ST_TimerName

        If Val(ST_TimerQ) > 0 Then
        'Reinsert into queue threads with pos delay value.
            EndTick = Val(ST_EndTickQ) + Val(ST_TimerQ)
            TimerDat = Val(ST_TimerQ) & ":" & ST_TimerName
            Call AddToQ(TimerDat, EndTick)
        End If

        If ST_TimerQ = vbNullString Then
            EOQ = True
        Else
            GetNextQ
        End If
    Loop
Exit Sub
ErrHandler:
    'Break Key
End Sub 'SetTimerQLoop

Sub AddToQ(ByVal TimerDat As String, ByVal EndTick As Long)
    Dim EndTickArray() As String
    Dim TimerArray() As String
    Dim LastTickIndex As Integer
    Dim LastTimerIndex As Integer

    Dim PosDatDel As Integer
    Dim TimerDelay As Long
    Dim TimerName As String
    Dim QFirstTick As Long
    Dim QLastTick As Long

    PosDatDel = Len(TimerDat) - InStr(TimerDat, ":")
    TimerDelay = Val(TimerDat)
    TimerName = Right(TimerDat, PosDatDel)

    If ST_EndTickQ = vbNullString Then
    'First timer
        ST_TimerName = TimerName
        ST_EndTickQ = EndTick
        ST_TimerQ = TimerDat
        SetTimerQLoop
    ElseIf InStr(ST_EndTickQ, "|") = 0 Then
    'Second timer
        If EndTick < Val(ST_EndTickQ) Then
        'New timer is first of 2 in Q
            ST_TimerName = TimerName
            ST_EndTickQ = EndTick & "|" & ST_EndTickQ
            ST_TimerQ = TimerDat & "|" & ST_TimerQ
        Else
        'New timer is 2nd of 2 in Q
            ST_TimerName = TimerNameF(ST_TimerQ)
            ST_EndTickQ = ST_EndTickQ & "|" & EndTick
            ST_TimerQ = ST_TimerQ & "|" & TimerDat
        End If
    Else
    '3rd+ timer: split queue into an array to find new timers position in queue.
        TimerArray = Split(ST_TimerQ, "|")
        LastTimerIndex = UBound(TimerArray)
        EndTickArray = Split(ST_EndTickQ, "|")
        LastTickIndex = UBound(EndTickArray)
        ReDim Preserve EndTickArray(LastTickIndex)
        ReDim Preserve TimerArray(LastTimerIndex)
        QFirstTick = Val(ST_EndTickQ)
        QLastTick = Val(EndTickArray(LastTickIndex))

        If EndTick < QFirstTick Then
        'Front of queue
            ST_EndTickQ = EndTick & "|" & ST_EndTickQ
            ST_TimerQ = TimerDat & "|" & ST_TimerQ
            ST_TimerName = Val(ST_TimerQ)
        ElseIf EndTick > QLastTick Then
        'Back of queue
            ST_TimerName = TimerNameF(ST_TimerQ)
            ST_EndTickQ = ST_EndTickQ & "|" & EndTick
            ST_TimerQ = ST_TimerQ & "|" & TimerDat
        Else
        'Somewhere mid queue
            For i = 1 To LastTimerIndex
                If EndTick < EndTickArray(i) Then
                    ST_EndTickQ = Replace(ST_EndTickQ, EndTickArray(i - 1), _
                    EndTickArray(i - 1) & "|" & EndTick)
                    ST_TimerQ = Replace(ST_TimerQ, TimerArray(i - 1), _
                    TimerArray(i - 1) & "|" & TimerDat)
                    Exit For
                End If
            Next i
            ST_TimerName = TimerNameF(ST_TimerQ)
        End If
    End If
End Sub 'AddToQ

Sub RemoveFromQ(ByVal TimerName As String)
    Dim EndTickArray() As String
    Dim TimerArray() As String
    Dim LastTickIndex As Integer
    Dim LastTimerIndex As Integer
    Dim PosDel As Integer

    PosDel = InStr(ST_EndTickQ, "|")

    If PosDel = 0 Then
    'Last element remaining in queue
        ST_EndTickQ = vbNullString
        ST_TimerQ = vbNullString
        ST_TimerName = vbNullString
    Else
    '2+ elements in queue
        TimerArray = Split(ST_TimerQ, "|")
        LastTimerIndex = UBound(TimerArray)
        EndTickArray = Split(ST_EndTickQ, "|")
        LastTickIndex = UBound(EndTickArray)
        ReDim Preserve EndTickArray(LastTickIndex)
        ReDim Preserve TimerArray(LastTimerIndex)
        ST_TimerQ = vbNullString
        ST_EndTickQ = vbNullString
        For i = 0 To LastTimerIndex
            If InStr(TimerArray(i), TimerName) = 0 Then
                If ST_TimerQ = vbNullString Then
                    ST_TimerQ = TimerArray(i)
                    ST_EndTickQ = EndTickArray(i)
                    X = Len(ST_TimerQ) - InStr(ST_TimerQ, ":")
                    ST_TimerName = Right(ST_TimerQ, X)
                Else
                    ST_TimerQ = ST_TimerQ & "|" & TimerArray(i)
                    ST_EndTickQ = ST_EndTickQ & "|" & EndTickArray(i)
                End If
            End If
        Next i
    End If
End Sub 'RemoveFromQ

Sub GetNextQ()
    Dim PosDel As Integer

    PosDel = InStr(ST_EndTickQ, "|")
    If PosDel = 0 Then
    'Last element remaining in queue
        ST_EndTickQ = vbNullString
        ST_TimerQ = vbNullString
        ST_TimerName = vbNullString
    Else
    '2+ elements in queue
        ST_EndTickQ = Right(ST_EndTickQ, Len(ST_EndTickQ) - PosDel)
        ST_TimerQ = Right(ST_TimerQ, Len(ST_TimerQ) - InStr(ST_TimerQ, "|"))
        ST_TimerName = TimerNameF(ST_TimerQ)
    End If
End Sub 'GetNextQ

Public Function TimerNameF(ByVal TimerQ As String) As String
    Dim StrLen As Integer
    If InStr(ST_TimerQ, "|") Then
        StrLen = InStr(ST_TimerQ, "|") - InStr(ST_TimerQ, ":") - 1
    Else
        StrLen = Len(ST_TimerQ) - InStr(ST_TimerQ, ":")
    End If
    TimerNameF = Mid(ST_TimerQ, InStr(ST_TimerQ, ":") + 1, StrLen)
End Function

Sub TestSetTimer1()
'Call SubA every 5 seconds
    Call SetTimer("SubA", 600)
End Sub

Sub TestSetTimer2()
'Call SubB every second
    Call SetTimer("SubB", 200)
End Sub

Sub TestSetTimer3()
'Stop calling SubA
    Call SetTimer("SubA", 0)
End Sub

Sub TestSetTimer4()
'Stop calling SubB
    Call SetTimer("SubB", 0)
End Sub

Sub TestSetTimer5()
'Call SubC one time after a 3 second delay.
    Call SetTimer("SubC", -3000)
End Sub


Sub SubA()
    Debug.Print "SubA Queue: " & ST_TimerQ & ", EndTickQ: " & ST_EndTickQ
End Sub

Sub SubB()
    Debug.Print "SubB Queue: " & ST_TimerQ & ", EndTickQ: " & ST_EndTickQ
End Sub

Sub SubC()
    Debug.Print "SubC Queue: " & ST_TimerQ & ", EndTickQ: " & ST_EndTickQ
End Sub

私は専門家のコーダーではないので、他の人がもっと上手にできると確信していますが、書かれているとおりにかなりうまく動作します。コードの大部分は、おそらくより効率的に実行できるキューを管理するだけです。

SetTimer のほかに、スケジュールに従って、マウスまたはキーボードのイベントでトリガーするスレッドを作成したり、アクティブなウィンドウの画面スクレイピング ピクセルに対してトリガーしたりすることもできます。

スレッドは、設計時にコードをアクティブにするタイミングがわからない場合に役立ちます。例えば：

オンライン トーナメント ポーカー用のポーカー HUD+DB を作成します。数百ミリ秒ごとに 1 つのスレッドが実行され、新しいハンドが開始されたときに最後の HH を読み取ってデータベースと hud を更新したり、新しいプレーヤーがテーブルに参加してトーナメント追跡サイトで自動ルックアップを行ったりするなどのトリガーを待機します。別のスレッドが 1 秒ごとに実行され、hud に表示されるトーナメント クロックが更新され、レベルが変更される前に 3 分間の警告が表示されます。

別のシェル スクリプトを作成して、事前にスケジュールした新しいトーナメントに自動的に参加するスレッドを実行することもできます。その後、プレイするテーブルごとにスクリプトの新しいコピーを起動できます。スクリプトの複数のコピーを起動したり、異なるプロジェクトからスクリプトを実行したりすることで、VBA を使用して本当にマルチスレッド化できるかどうかはわかりませんが、フォーラムで見たものに基づいて、それを疑っています。

バグなしで実行されていた間、私はそれを少しきれいにするためにいくつかの変更を加え、修正する機会がなかったいくつかのマイナーなバグを導入したことに注意してください.

于 2014-07-10T20:50:45.030 に答える