Question

VBA的新手，我整理了以下代码，该代码根据Column中的活动对某些单元格进行了更改。

我将动作分成多个模块以使其更易于遵循，但是现在这仅在复制/粘贴列中的更改时才有效（如果我在该列中键入该宏，则该宏将不起作用）。

有什么主意我想念的吗？

工作表代码

Option Explicit
'Event Macro to put formulas in A, B and D if C changes
Private Sub Worksheet_Change(ByVal Target As Range) ' Every Change on this sheet do this code
Dim lRow As Long
Dim cell As Range
Dim CKeyCells As Range

' Set SelectionColumn range
Set CKeyCells = Range("$C$3:$C$1048576")

If Not Intersect(Target, Columns(3)) Is Nothing Then 'If the Change wasn't in Column
    CbuddyMacro
End If
End Sub

模块/宏代码

Public Sub CbuddyMacro()
Dim lRow As Long
Dim cell As Range
Dim selectedRange As Range

Set selectedRange = Application.Selection

    For Each cell In selectedRange
        If cell.Value <> "" Then 'If Col has something in it then do the following.
            lRow = cell.Row 'Get the current row
            Cells(cell.Row, "A").Formula = "=IF(ISBLANK(I" & lRow & "),"""",I" & lRow & ")"
            Cells(cell.Row, "B").Formula = "=IF(ISBLANK(J" & lRow & "),"""",J" & lRow & ")"
            Cells(cell.Row, "D").Formula = "=IF(ISBLANK(K" & lRow & "),"""",K" & lRow & ")"
            Cells(cell.Row, "E").Formula = "=IFERROR(INDEX(Database!$E$3:$E$1048576,MATCH(C" & lRow & ",Database!$C$3:Database!$C$1048576,0),0),"""")"
            Cells(cell.Row, "F").Formula = "=IFERROR(IF(ISBLANK(INDEX(Database!$F$3:$F$1048576,MATCH(C" & lRow & ",Database!$C$3:Database!$C$1048576,0),0)),INDEX(Database!$P$3:$P$1048576,MATCH(C" & lRow & ",Database!$C$3:Database!$C$1048576,0),0),INDEX(Database!$F$3:$F$1048576,MATCH(C" & lRow & ",Database!$C$3:Database!$C$1048576,0),0)),"""")"
            Cells(cell.Row, "G").Formula = "=IFERROR(IF(ISBLANK(INDEX(Database!$G$3:$G$1048576,MATCH(C" & lRow & ",Database!$C$3:Database!$C$1048576,0),0)),INDEX(Database!$Q$3:$Q$1048576,MATCH(C" & lRow & ",Database!$C$3:Database!$C$1048576,0),0),INDEX(Database!$G$3:$G$1048576,MATCH(C" & lRow & ",Database!$C$3:Database!$C$1048576,0),0)),"""")"
            Cells(cell.Row, "H").Formula = "=IF(ISBLANK(L" & lRow & "),"""",L" & lRow & ")"
            Cells(cell.Row, "I").Formula = "=IFERROR(TEXT(LOOKUP(2,1/($M$" & lRow & ":$AP$" & lRow & "<>""""),$M$" & lRow & ":$AP$" & lRow & "),""DD-MMM-YY""),"""")"
            Cells(cell.Row, "J").Formula = "=IFERROR(TEXT(LOOKUP(2,1/($BU$" & lRow & ":$CX$" & lRow & "<>""""),$BU$" & lRow & ":$CX$" & lRow & "),""DD-MMM-YY""),"""")"
            Cells(cell.Row, "K").Formula = "=IFERROR(LOOKUP(2,1/($AQ$" & lRow & ":$BT$" & lRow & "<>""""),$AQ$" & lRow & ":$BT$" & lRow & "),"""")"
            Cells(cell.Row, "L").Formula = "=IFERROR(LOOKUP(2,1/($CY$" & lRow & ":$EB$" & lRow & "<>""""),$CY$" & lRow & ":$EB$" & lRow & "),"""")"
        End If
        If cell.Value = "" Then 'If Col has nothing in it then do the following.
            Cells(cell.Row, "A").Formula = ""
            Cells(cell.Row, "B").Formula = ""
            Cells(cell.Row, "D").Formula = ""
            Cells(cell.Row, "E").Formula = ""
            Cells(cell.Row, "F").Formula = ""
            Cells(cell.Row, "G").Formula = ""
            Cells(cell.Row, "H").Formula = ""
            Cells(cell.Row, "I").Formula = ""
            Cells(cell.Row, "J").Formula = ""
            Cells(cell.Row, "K").Formula = ""
            Cells(cell.Row, "L").Formula = ""
        End If
    Next cell

更改事件中的VBA宏不适用于键入的数据条目

0 个答案: