计数器脚本会导致未alignment的值

我目前无法alignment由VBA脚本设置的结果。

Sheet2是input/修改数据的地方。 Sheet1只是界面，抓取Sheet2的数据并显示计数。 Sheet2的Worksheet_Change事件处理程序是脚本更新Sheet1!B:B计数的次数， Sheet2!A:A的值已更改的次数。

此时，当Sheet1!A:A的公式正确运行时， Sheet1!A:A将从Sheet2!A:A的相应行中复制该值Sheet2!A:A ：

➡

第一组图像显示了一些值首次进入Sheet2后的初始状态。 第二组显示更改Sheet2!A2和Sheet2!A5后的结果。

这是脚本：

 Option Explicit Private Sub Worksheet_Change _ ( _ ByVal Target As Range _ ) Const s_CheckColumn As String = "A:A" Const s_CountColumn As String = "B:B" If Intersect(Target, Range(s_CheckColumn)) Is Nothing Then Exit Sub Dim rngCell As Range For Each rngCell In Intersect(Target, Range(s_CheckColumn)) With Worksheets("Sheet1").Range(s_CountColumn).Cells(rngCell.Row) .Value2 = IIf(.Value2 <> vbNullString, .Value2 + 1, IIf(rngCell.Value2 <> vbNullString, 0, vbNullString)) End With Next rngCell End Sub 

但是，现在我想使用Sheet1!A:A的索引匹配公式来从Sheet2获取值Sheet1!A:A 。 这会导致一些行被跳过。 不幸的是，这导致一些计数错位：

➡

如您所见，当Sheet2!A5更改时， Sheet1!B5中的计数将被更新，而不是Sheet1!B3中的计数。

我怎样才能使脚本与Sheet1的值正确Sheet1呢？

Answer 1

最简单的方法来修改现有的代码，使其符合新的要求（即Sheet1行不再需要对应于Sheet2相同的编号的行），在Sheet1使用额外的列，例如C列，其公式是列A中的INDEX-MATCH公式的MATCH部分。

对于你提供的例子，这两张纸最初看起来像这样：

然后可以使用Sheet1!C:C的行号来查找与Sheet2!A:A （通过在行号中查找已更改的单元格的行）中已更改的单元格对应的Sheet1中的行。 增加该行的B列可使计数正确alignment：

 '============================================================================================ ' Module : <The appropriate sheet module> ' Version : 1.0.2 ' Part : 1 of 1 ' References : N/A ' Source : https://stackoverflow.com/a/47447013/1961728 '============================================================================================ Option Explicit Private Enum e_MatchType GreaterThan = -1 ExactMatch LessThan End Enum Private Sub Worksheet_Change _ ( _ ByVal Target As Range _ ) Const s_LogSheetName As String = "Sheet1" Const s_CheckColumn As String = "A:A" Const s_CountColumn As String = "B:B" Const s_MatchColumn As String = "C:C" Const s_InputColumn As String = "A:A" Const l_Error As String = "Error" If Intersect(Target, Range(s_InputColumn)) Is Nothing Then Exit Sub With Worksheets(s_LogSheetName) Dim rngCell As Range For Each rngCell In Intersect(Target, Range(s_InputColumn)) Dim varMatchingLogRow As Variant varMatchingLogRow = Application.Match(rngCell.Row, .Range(s_MatchColumn), e_MatchType.ExactMatch) If TypeName(varMatchingLogRow) <> l_Error Then If .Range(s_MatchColumn).Cells(varMatchingLogRow) = rngCell.Row Then With .Range(s_CountColumn).Cells(varMatchingLogRow) .Value2 = IIf(.Value2 <> vbNullString, .Value2 + 1, IIf(rngCell.Value2 <> vbNullString, 0, vbNullString)) End With End If End If Next rngCell End With End Sub 

注意：
如果Sheet2!A:A中的值保证是唯一的，或者跟踪相同的Sheet2!A:A是可以接受的Sheet2!A:A 第一个匹配的Sheet1!A:A中的值发生变化Sheet1!A:A一行，那么可以不使用Sheet1额外列。