2

中央の入力シートがあるマクロを作成しています。このシートを「メイン入力シート」と呼びましょう。ここで、ユーザーは関連する変数を入力します。「メイン入力シート」には、「他に入力シートはありますか?」といういくつかの入力があります。- 「はい」の場合、入力に対応するワークシートが表示されます (以前は非表示でした) - 「関連付けられた入力シート」と呼びましょう。ここで、マクロを実行する前に、ユーザーが「関連付けられた入力シート」を更新することを確認したいと思います。これを行う方法はありますか - VBA が提供するイベント ハンドラーを使用するか、他の方法を使用しますか?

4

2 に答える 2

2

Worksheet_Changeイベントプロシージャは、シートの他の場所で多くの変更を行う他のことが発生していない限り、おそらく実行する方法です。

その時点で、あなたの質問は言い換えることができます:「最後にチェックしてから私の範囲は変更されましたか?」

範囲のコピーを取得してどこかに保存し、現在の範囲をキャッシュされたコピーとセルごとに照合することは、ブルートフォースアプローチです。1回だけ実行する場合は問題ありませんが、実行する場合は問題ありません。繰り返し、ハッシュ(ある種のチェックサム関数によって生成された短いコードまたは数値)を格納する方が効率的です。

チェックサムアルゴリズムはさまざまです。Adler32はシンプルで高速ですが、パフォーマンスが悪くなります。たとえば、6〜10文字の単一の単語のペアを比較すると、「ハッシュ衝突」が発生したり、異なるデータ入力に対して異なるハッシュを返さなかったりします。ただし、24個の8文字の単語の列、または数千の日付と数字のテーブルへの変更を検出するように求められた場合は、実際に非常にうまく機能します。

他のハッシュを調べて、最新の状態に保ちます。PCには、MD5やsha1などのハッシュを含むいくつかのライブラリがあり、VBAの手動ハッシュよりもパフォーマンスが優れているはずです。

Adler-32チェックサムを使用したデモコードを次に示します。コードコメントを読んでください。これをプロジェクトに適合させるために知っておく必要のあることがあります。

Public Function RangeHasChanged() As Boolean

' Demonstration function for use of the Checksum() function below.

' For more advanced users, I have a 'Watched Range' class on the website:
'   http://excellerando.blogspot.com

' Author: Nigel Heffernan, May 2006  http://excellerando.blogspot.com

' Please note that this code is in the public domain. Mark it clearly, with
' the author's name, and segregate it from any proprietary code if you need
' to assert ownership & commercial confidentiality on that proprietary code

' Coding Notes:

' It is expected that this function will be saved in the host worksheet's
' module and renamed to indicate the range or table being monitored. It's a
' good idea to use a named range rather than a hardcoded address.

' You might also choose to edit the '1 To 255' to the width of your range.

' Initialising the static values so that the first check in your VBA session
' does not automatically register a 'change' is left as an exercise for the
' reader: but calling the function on opening the workbook works well enough

' This is intended for use in VBA, not for use on the worksheet. Use the
' setting 'Option Private Module' to hide this from the function wizard.

    Dim rngData As Excel.Range
    Dim arrData As Variant

    Dim lngChecksum As Long
    Static lngExisting As Long

    ' Note that we capture the entire range in an Array, then work on the array:
    ' this is a single 'hit' to the sheet (the slow operation in any interaction
    ' with worksheet data) with all subsequent processing in VBA.

    ' BS 10/11/2021:  Modified to look at the current selection if the hard-coded worksheet does not exist.
    If Evaluate("ISREF('DataEntryMain'!A1)") Then
        Set rngData = ThisWorkbook.Names("DataEntryMain").RefersToRange
    Else
        Set rngData = Intersect(Selection, Selection.parent.UsedRange) ' Reduce the range so it is never bigger than the UsedRange.
    End If
    
    arrData = rngData.Value2

    RangeHasChanged = False

    lngChecksum = CheckSum(arrData)

    If rngData.count > 1 Then
        ' The passed range is more than one cell.  Release the dynamic-array storage space.
        Erase arrData
    End If

    ' lngExisting is zero when the file opens, and whenever the
    ' VBA project is reinitialised, clearing all the variables.
    ' Neither of these events should be reported as a 'change'.

    If lngExisting <> lngChecksum And lngExisting <> 0 Then
        RangeHasChanged = True
    End If

    lngExisting = lngChecksum

    Debug.Print RangeHasChanged, "The Adler-32 for " & rngData.Address & " is " & lngChecksum, Hex(lngChecksum)

End Function


' I could've sworn I posted this here, years ago, but here's an implementation of Adler-32 in
' 32-bit VBA.
'
' There 's a horrible hack in it: Adler-32 returns a 32-bit integer, and the VBA Long is a signed
' integer with a range ± (2^31) -1, so I've implemented a 'wrap around' of the overflow at +2^31,
' restarting at -2^31 +1. And done something I really, really shouldn't have done with a
' floating-point variable. Eventually everyone, everywhere, will have 64-bit Office and this'll
' be kind of quaint and unnecessary... Right?
'
' Of course, the real question is: why bother?
'
' It boils down to the common question of checking for changes: if you don't want to use the 'on
' change' event, or you're dealing with data directly in VBA before it hits the sheet, large data
' sets need something better than an item-by-item brute force approach. At least, if you're doing
' it more than once: the cost of rolling each item into your hash is always more than the cost of
' the one-by-one comparison...
'
' ...And that's still true if you're importing a fast hashing algorithm from MySQL or one of the
' web API libraries (try MDA5, if you can get at an exposed function), unless you can find
' something that reads VBA variant arrays directly and relieve your VBA thread of the task of
' enumerating the list values into the imported function.
'
' Meanwhile, here's a hash algorithm that's within reach of VBA: Adler32.  The details are in
' Wikipedia’s article on Adler32: http://en.wikipedia.org/wiki/Adler-32 and an hour's testing
' will teach you some lessons about hashing:
'
' 'Hash collisions' (differing data sets returning the same hash code) are more common than you
' expected, especially with data containing repeated patterns (like dates);>
' Choice of hashing algorithm is important;
' ...And that choice is more of an art than a science;
' Admitting that you really shouldn't have bothered and resorting to brute force is often the
' better part of valour.
'
' Adler-32 is actually more useful as a tool to teach those lessons, than as a workaday checksum.
' It's great for detecting changes in lists of more than 100 distinct items; it's tolerable, on a
' list of 24 randomly-generated 8-letter words (hash collisions at 1 in 1800 attempts) and it
' starts giving you single-digit percentage occurrences of the hash collision error in a list of
' 50 not-so-distinct option maturities, where the differences are mostly in the last 10 chars and
' those ten chars are recurring 3-month maturity dates.
'
' By the time you're comparing pairs of 6-letter strings, more than 10% of your changes will be
' missed by the checksum in a non-random data set. And then you realise that might as well be
' using string comparison for that kind of trivial computation anyway.
'
' So the answer is always: test it.
'
' Meanwhile, here 's the algorithm, horrible hacks and all:


Public Function CheckSum(ByRef ColArray As Variant) As Long
    Application.Volatile False

    ' Returns an Adler32 checksum of all the numeric and text values in a column

    ' Capture data from cells as myRange.Value2 and use a 32-bit checksum to see
    ' if any value in the range subsequently changes. You can run this on multi-
    ' column ranges, but it's MUCH faster to run this separately for each column
    '
    ' Note that the VBA Long Integer data type is not a 32-bit integer, it's a
    ' signed integer with a range of  ± (2^31) -1. So our return value is signed
    ' and return values exceeding +2^31 -1 'wraparound' and restart at -2^31 +1.

    ' Coding Notes:

    ' This is intended for use in VBA, and not for use on the worksheet. Use the
    ' setting  'Option Private Module' to hide CheckSum from the function wizard

    ' Author: Nigel Heffernan, May 2006  http://excellerando.blogspot.com
    ' Acknowledgements and thanks to Paul Crowley, who recommended Adler-32

    ' Please note that this code is in the public domain. Mark it clearly, with
    ' the author's name, and segregate it from any proprietary code if you need
    ' to assert ownership & commercial confidentiality on your proprietary code

    Const LONG_LIMIT As Long = (2 ^ 31) - 1
    Const MOD_ADLER As Long = 65521

    Dim a As Long
    Dim b As Long

    Dim i As Long
    Dim j As Long
    Dim k As Long

    Dim arrByte() As Byte

    Dim dblOverflow As Double

    If TypeName(ColArray) = "Range" Then
        ColArray = ColArray.Value2
    End If

    If IsEmpty(ColArray) Then
        CheckSum = 0
        Exit Function
    End If

    If (VarType(ColArray) And vbArray) = 0 Then
        ' single-cell range, or a scalar data type
        ReDim arrData(0 To 0, 0 To 0)
        arrData(0, 0) = CStr(ColArray)
    Else
        arrData = ColArray
    End If

    a = 1
    b = 0

    For j = LBound(arrData, 2) To UBound(arrData, 2)
        For i = LBound(arrData, 1) To UBound(arrData, 1)

            ' VBA Strings are byte arrays: arrByte(n) is faster than Mid$(s, n)

            arrByte = CStr(arrData(i, j))  ' Is this type conversion efficient?

            For k = LBound(arrByte) To UBound(arrByte)
                a = (a + arrByte(k)) Mod MOD_ADLER
                b = (b + a) Mod MOD_ADLER
            Next k

            ' Terminating each item with a 'vTab' char constructs a better hash
            ' than vbNullString which, being equal to zero, adds no information
            ' to the hash and therefore permits the clash ABCD+EFGH = ABC+DEFGH
            ' However, we wish to avoid inefficient string concatenation, so we
            ' roll the terminating character's bytecode directly into the hash:

            a = (a + 11) Mod MOD_ADLER                ' vbVerticalTab = Chr(11)
            b = (b + a) Mod MOD_ADLER

        Next i

        ' Roll the column into the hash with a terminating horizontal tab char:

        a = (a + 9) Mod MOD_ADLER                     ' Horizontal Tab = Chr(9)
        b = (b + a) Mod MOD_ADLER


    Next j

    ' Using a float in an integer calculation? We can get away with it, because
    ' the float error for a VBA double is < ±0.5 with numbers smaller than 2^32

    dblOverflow = (1# * b * MOD_ADLER) + a

    If dblOverflow > LONG_LIMIT Then  ' wraparound 2^31 to 1-(2^31)    
        Do Until dblOverflow < LONG_LIMIT
            dblOverflow = dblOverflow - LONG_LIMIT
        Loop
        CheckSum = 1 + dblOverflow - LONG_LIMIT
    Else
        CheckSum = b * MOD_ADLER + a
    End If

End Function
    
于 2012-05-15T11:08:11.860 に答える
1

おそらくあなたが望むことをする Worksheet_change イベントがあります:

Private Sub Worksheet_Change(ByVal Target As Range)

End Sub

これを「メイン情報シート」のコードに配置すると、シートが変更されるたびに実行されます。

ただし、シートが更新されるたびにスプレッドシートを実行するのではなく、更新されたかどうかのみを確認したい場合...できることは、このようなグローバル変数を作成することです(宣言を配置する必要があります標準モジュールで:

Global MainSheetHasChanged as Boolean

次に、次のコード行を worksheet_changed マクロに挿入します。

Private Sub Worksheet_Change(ByVal Target As Range)
    MainSheetHasChanged = True
End Sub

他のマクロを実行した後は、常に変数を false に戻すようにしてください。これはあなたが探しているものですか?

于 2012-05-14T12:36:25.053 に答える