2

我正在编写一个宏,其中有一个中央输入表-让我们将此表称为-“主输入表”,用户在其中输入相关变量。在“主要输入表”中有一些输入说 - “还有输入表吗?” - 当“是”时,将显示与输入相对应的工作表(它以前被隐藏) - 我们称之为“关联输入表”。现在,我想确保用户在运行宏之前更新“关联输入表”。有没有办法可以做到这一点 - 使用 VBA 提供的事件处理程序或使用任何其他方式?

4

2 回答 2

2

Worksheet_Change 事件过程可能是要走的路,除非您在工作表的其他地方发生了其他事情,从而进行了大量更改。

那时,您的问题可以改写为:“自从我上次检查以来,我的范围有变化吗?”

抓取范围的副本并将其存储在某处,并逐个单元格地检查缓存副本的当前范围是一种蛮力方法:如果你只做一次也没关系,但如果你正在做它反复存储哈希更有效 - 由某种校验和函数生成的短代码或数字。

校验和算法各不相同。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 回答