使用按钮根据条件条件复制 Excel 中的行答案

【问题标题】：Copy Rows in Excel based on Critera condition with Button使用按钮根据条件条件复制 Excel 中的行
【发布时间】：2015-02-12 13:43:26
【问题描述】：

我这几天一直在为一个 Excel 问题苦苦挣扎。我的 Excel 工作簿有两张名为“Sheet1”和“Sheet2”的工作表。

两个工作簿中的标题相同，范围为 A2:M2。

我希望通过 vba 实现的是在每行 N3、N4 等的末尾引入一个按钮，该按钮将删除该行并将其粘贴到“Sheet2”下一个可用行中。我需要 N3:N102 行中最多 100 个按钮。如果选择宏按钮 N10（例如），它会将内容 A10:M10 从“Sheet1”复制到“Sheet2”中的下一个可用行（在 A2:M2 之后）。并从“Sheet1”中删除 A:10:M10 行。同时保持 100 个按钮...

这对我想要实现的目标有意义吗？我迄今为止搜索过的所有编码都不包括按钮功能。

感谢您的帮助和时间。

【问题讨论】：

您可能不会找人为您编写代码。您是否尝试过手动添加这些按钮并使用宏记录器开始？尝试获取一些示例代码，让您更接近并在此处发布特定问题。
谢谢我有一些我试过的代码，是的，它们有效。我会尽快发布它们。我遇到的问题是删除了行但保留了侧面的按钮。

标签： vba excel

【解决方案1】：

如果我理解就在这里。第一个 sub 取自 belisarius 并适合填充从 2 到 100 的每一行，然后我为每个按钮分配一个名为 myMacro 的宏。

Sub addButton()
Dim btn As Button
Application.ScreenUpdating = False
ActiveSheet.Buttons.Delete
Dim t As Range


For i = 2 To 100 Step 1
   Set t = ActiveSheet.Range(Cells(i, 14), Cells(i, 14))
   Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
   With btn
     .OnAction = "btnS"
     .Caption = "Btn " & i
     .Name = i
     .OnAction = "myMacro"
   End With
Next i

Application.ScreenUpdating = True

End Sub

您可以根据需要多次运行它，因为它只会清除并重新制作 99 个（红色 - 无法抗拒，实际上不是红色）按钮。

Sub myMacro()
Dim sheet1, sheet2 As Worksheet
Dim ButtonName As Integer
Dim checkBlankRange As Range
Dim answerRange As Range
Dim pasteRow As Integer

Set sheet1 = ActiveWorkbook.Sheets("Sheet1")
Set sheet2 = ActiveWorkbook.Sheets("sheet2")
Set checkBlankRange = sheet2.Range("A:A")

ButtonName = Application.Caller

Set answerRange = sheet1.Range("a" & ButtonName & ":m" & ButtonName)


        For Each cell In checkBlankRange
            If cell.Value = "" Then 'first empty cell
                    pasteRow = cell.row 'get the row number of the empty cell
                    sheet2.Range("a" & pasteRow & ":m" & pasteRow).Value2 = answerRange.Value2
                Exit For
            End If
        Next cell

answerRange.Delete Shift:=xlUp

End Sub

第二部分获取我们在 sheet1 上的第一个宏中设置的按钮名称，并根据“A:A”范围分配给 sheet2 上的第一个空行。最后，它会删除 sheet1 上与您选择的按钮相对应的范围。

【讨论】：

【解决方案2】：

这是另一个版本：

Sub CreateButtons()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim NCell As Range
    Dim i As Long

    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")

    ws1.Buttons.Delete

    For Each NCell In ws1.Range("N3:N102").Cells
        i = i + 1
        With ws1.Buttons.Add(NCell.Left, NCell.Top, NCell.Width, NCell.Height)
            .Name = "btn_MoveRow_" & Format(i, "00#")
            .Characters.Text = "Move Row"
            .OnAction = "MoveRow"
        End With
    Next NCell

End Sub

以及分配给按钮的 MoveRow 子程序：

Sub MoveRow()

    Dim ws1 As Worksheet
    Dim ws2 As Worksheet

    Set ws1 = ActiveWorkbook.ActiveSheet
    Set ws2 = ActiveWorkbook.Sheets("Sheet2")

    With Intersect(ws1.Range("A:M"), ws1.Buttons(Application.Caller).TopLeftCell.EntireRow)
        ws2.Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(, .Columns.Count).Value = .Value
        .Delete xlShiftUp
    End With

End Sub

【讨论】：

【解决方案3】：

JamesC 和tigeravatar，

非常感谢您的时间和精力，这些代码非常适合我想要做的事情。

我设法获得了要创建的按钮，但无法让移动和复制为我工作。但是您的两种解决方案都非常适合我尝试做的事情。

再次感谢！！

【讨论】：

很好，你应该选择一个答案