Excel VBA如何提取被修改单元格对应的行首列首单元格值存入数组

VBA代码修改方案 #

核心修改逻辑 #

原代码直接调用Target对象的行列属性无法适配多单元格修改场景，我们需要在提取每个被修改单元格基础数据时，同步抓取对应行首、列首的值存入数组，适配任意多单元格同时修改的场景。

完整修改后代码 #

Private Sub Worksheet_Change(ByVal Target As Range)

Dim RangeValues As Variant, r As Long, boolOne As Boolean, TgValue '存储修改前的目标单元格值数组
 Dim sh As Worksheet: Set sh = Sheets("Log")
 Dim UN As String: UN = Application.UserName
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual
 
 If Target.Cells.count > 1 Then
    TgValue = extractData(Target)
 Else
    TgValue = Array(Array(Target.Value, Target.Address(0, 0), _
        Cells(Target.Row, 1).Value, Cells(1, Target.Column).Value))  '单个单元格场景也同步存储行首、列首值
    boolOne = True
 End If
 Application.EnableEvents = False                               '避免Undo后触发二次Change事件
     Application.Undo
     RangeValues = extractData(Target)                                 '提取修改前的值
     putDataBack TgValue, ActiveSheet                           '恢复修改后的值
     If boolOne Then Target.Offset(1).Select
 Application.EnableEvents = True

 For r = 0 To UBound(RangeValues)
    If RangeValues(r)(0) <> TgValue(r)(0) Then
        '数组新增两个元素：对应行首值、对应列首值，Resize列数从6改为8
        sh.Cells(Rows.count, 1).End(xlUp).Offset(1, 0).Resize(1, 8).Value = _
          Array(Now, UN, RangeValues(r)(1), RangeValues(r)(0), TgValue(r)(0), _
          Target.Parent.Name, RangeValues(r)(2), RangeValues(r)(3))
        
    End If
 Next r
 
 Application.ScreenUpdating = True
 Application.Calculation = xlCalculationAutomatic
End Sub

Sub putDataBack(arr, sh As Worksheet)
    Dim El
    For Each El In arr
        sh.Range(El(1)).Value = El(0)
    Next
End Sub

Function extractData(rng As Range) As Variant
    Dim a As Range, arr, count As Long, i As Long
    ReDim arr(rng.Cells.count - 1)
    For Each a In rng.Areas
            For i = 1 To a.Cells.count
                '数组存储结构调整为：[单元格值, 单元格地址, 行首(A列同行)值, 列首(第1行同列)值]
                arr(count) = Array(a.Cells(i).Value, a.Cells(i).Address(0, 0), _
                Cells(a.Cells(i).Row, 1).Value, Cells(1, a.Cells(i).Column).Value): count = count + 1
            Next
    Next
    extractData = arr
End Function

自定义调整说明 #

如果你的行首不是A列、列首不是第1行，仅需修改extractData函数中对应参数即可：

• 调整行首列：将Cells(a.Cells(i).Row, 1)里的1改为行首对应的列号（如B列改为2）
• 调整列首行：将Cells(1, a.Cells(i).Column)里的1改为列首对应的行号（如第2行改为2）

内容的提问来源于stack exchange，提问作者Leedo