我已经为这个问题苦苦挣扎了一段时间了,我会尽我所能解释它。
我有一个活动表,其行号不断增加。每行都有一些必须存在的属性和隐藏单元格。所以我的问题是这样的:
当我来到行号(例如 100)并且表格已满时,我想在该行下输入一个具有与前一行相同属性的新行。
我设法在网上找到了一些代码并将它们合并成一个可运行的代码,但其中存在很多问题。代码如下:
Private Sub Workbook_Open()
Sub BlankLine()
Dim Col As Variant
Dim BlankRows As Long
Dim LastRow As Long
Dim R As Long
Dim StartRow As Long
Col = "C"
StartRow = 123
BlankRows = 1
LastRow = Cells(Rows.Count, Col).End(xlUp).Row
Application.ScreenUpdating = False
With ActiveSheet
For R = LastRow To StartRow + 1 Step -1
If IsEmpty(.Cells(R, Col)) = False Then
.Cells(R + 1, Col).EntireRow.Copy
.Cells(R + 1, Col).EntireRow.Insert Shift:=xlDown
Range("A1").ClearOutline
End If
Next R
End With
Application.ScreenUpdating = True
End Sub
因此,事情是这样的:当您打开 Excel 时,它会立即搜索行号 123 之后单元格 C 中有任何内容的行,并将下一个空行复制到当前行之后。这里的问题是,每次我打开 Excel 时,它都会这样做,并复制一份又一份的副本。
我需要它如何发生:当您打开 Excel 时,代码处于活动状态,当您填充行号 124 时,复制行 125 并将其插入到行 124 下方,并以行 124 结束。现在将代码移动到行号 125,当此行在单元格 C 中有数据时,复制行 126 并将其移动到 125 下方,然后停止,依此类推...
这个想法是让表格中的行主动增加并复制数据,这样当表格填满时您不必手动执行此操作。
抱歉解释得太长了,我希望有一个解决方案。
先感谢您。
答案1
您需要将代码从Workbook_Open()
事件中移出Worksheet_Change()
事件
还要确保Option Explicit
在所有模块中使用
将其放在 Sheet VBA 模块中。仅当 C 列中的单元格更新时才会触发
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge = 1 Then 'Check that only 1 cell is being edited
If Len(Target) > 0 Then 'Make sure the cell is not empty
With Target
If .Row > 1 And .Column = 3 Then 'Exclude Header row, and act on col 3
OptimizeApp True
MovePropRow Target
OptimizeApp False
End If
End With
End If
End If
End Sub
Private Sub MovePropRow(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Target.Parent
Dim lr As Long: lr = Target.Row
Dim lrProp As Long: lrProp = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row
If lrProp = lr Then
ws.Range(ws.Cells(lr, "D"), ws.Cells(lr, "I")).Copy
ws.Cells(lr + 1, "D").PasteSpecial xlPasteAll
ws.Range(ws.Cells(lr, "D"), ws.Cells(lr, "I")).Clear
Target.Select
End If
End Sub
Private Sub OptimizeApp(ByVal speedUp As Boolean)
Application.Calculation = IIf(speedUp, xlCalculationManual, xlCalculationAutomatic)
Application.ScreenUpdating = Not speedUp
Application.DisplayAlerts = Not speedUp
Application.EnableEvents = Not speedUp
End Sub
测试Sheet3
-Before
测试Sheet3
-After
(typing "x" in Cell "C10")