如何防止粘贴到多列?
How do I prevent pasting into multiple columns?
我是 VBA 的新手,我在使用以下代码片段时遇到了一个奇怪的问题。我的目标是在用户手动将数据粘贴到 table 时插入行。用户手动复制 table 的一部分(假设列 A1 到 C25 —— 保留列 D 和 E 不变),当手动将其粘贴到 A26 时,将插入行。这样,table 会扩展以适合数据(因为 table 下面有更多内容)。
现在,下面显示的代码可以正常工作,我遇到的唯一问题是列(A 到 C)中的粘贴数据在所有列(D 到 F、G 到 I 等)上重复。 )
如何防止此粘贴数据覆盖我插入的行上的其他列(并继续 "forever")
' When cells are pasted, insert # of rows to paste in
Dim lastAction As String
' If a Paste action was the last event in the Undo list
lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(lastAction, 5) = "Paste" Then
' Get the amount that was pasted (table didn't expand)
numOfRows = Selection.Rows.Count
' Undo the paste, but keep what is in the clipboard
Application.Undo
' Insert a row
ActiveCell.offset(0).EntireRow.Insert
End If
我使用命令栏的撤消控件的原因是因为此代码需要 运行 手动粘贴事件。
试一试。我从剪贴板中删除了数据,但首先将其存储到一个变量中,以便可以插入行,然后将数据添加到适当的位置,将其他列留空。
Private Sub Worksheet_Change(ByVal Target As Range)
' If a Paste action was the last event in the Undo list
Dim lastAction As String
lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(lastAction, 5) = "Paste" Then
Dim rng() As Variant
rng() = Target
numofRows = Target.Rows.Count 'get amount of rows pasted
numofColumns = Target.Columns.Count 'get amount of columns pasted
With Application
.EnableEvents = False 'stop events from firing momentarily
.Undo 'undo paste action
.CutCopyMode = False 'remove data from clipboard
End With
ActiveCell.Resize(numofRows, 1).EntireRow.Insert 'insert new amount of rows based on paste
ActiveCell.Resize(numofRows, numofColumns).Value = rng() 'replace pasted values
Application.EnableEvents = True 'turn back on event firing
End If
End Sub
我是 VBA 的新手,我在使用以下代码片段时遇到了一个奇怪的问题。我的目标是在用户手动将数据粘贴到 table 时插入行。用户手动复制 table 的一部分(假设列 A1 到 C25 —— 保留列 D 和 E 不变),当手动将其粘贴到 A26 时,将插入行。这样,table 会扩展以适合数据(因为 table 下面有更多内容)。
现在,下面显示的代码可以正常工作,我遇到的唯一问题是列(A 到 C)中的粘贴数据在所有列(D 到 F、G 到 I 等)上重复。 )
如何防止此粘贴数据覆盖我插入的行上的其他列(并继续 "forever")
' When cells are pasted, insert # of rows to paste in
Dim lastAction As String
' If a Paste action was the last event in the Undo list
lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(lastAction, 5) = "Paste" Then
' Get the amount that was pasted (table didn't expand)
numOfRows = Selection.Rows.Count
' Undo the paste, but keep what is in the clipboard
Application.Undo
' Insert a row
ActiveCell.offset(0).EntireRow.Insert
End If
我使用命令栏的撤消控件的原因是因为此代码需要 运行 手动粘贴事件。
试一试。我从剪贴板中删除了数据,但首先将其存储到一个变量中,以便可以插入行,然后将数据添加到适当的位置,将其他列留空。
Private Sub Worksheet_Change(ByVal Target As Range)
' If a Paste action was the last event in the Undo list
Dim lastAction As String
lastAction = Application.CommandBars("Standard").Controls("&Undo").List(1)
If Left(lastAction, 5) = "Paste" Then
Dim rng() As Variant
rng() = Target
numofRows = Target.Rows.Count 'get amount of rows pasted
numofColumns = Target.Columns.Count 'get amount of columns pasted
With Application
.EnableEvents = False 'stop events from firing momentarily
.Undo 'undo paste action
.CutCopyMode = False 'remove data from clipboard
End With
ActiveCell.Resize(numofRows, 1).EntireRow.Insert 'insert new amount of rows based on paste
ActiveCell.Resize(numofRows, numofColumns).Value = rng() 'replace pasted values
Application.EnableEvents = True 'turn back on event firing
End If
End Sub