Excel 如何移动选定单元格的部分行

我已经搜索了几个小时，找不到这个问题的答案。如果我在Excel电子表格中设置了一个表格

• 单元格A1至C1和E1至G1为列标题
• 单元格A2至G2和A3至G3为空白
• D列为空，但用黑色填充
• 第4行也是空的，但用黑色填充
• 单元格A5=1
• 单元格B5=2
• 单元格C5=3
• 单元E5=4
• 单元格F5=5
• 单元格G5=6
• 单元格A6=7
• 单元格B6=8
• 单元格C6=9
• 单元E6=10
• 单元格F6=11
• 单元格G6=12

这就是我需要的

当我选择C列中的任何单元格，同时选择E列中的任何单元格（因此，两个活动单元格）时，我需要同时执行以下操作：

选定列C单元格中的行数据（从A列到 列C）需要剪切并粘贴到中的下一个可用行 表格的顶部（第4行“涂黑”上方的部分） 在本例中是第2行，从A列到C列

选定列E单元格中的行数据（从列E到 列G）需要剪切并粘贴到中的下一个可用行 表格的顶部（第4行“涂黑”上方的部分） 在本例中，它也是第2行，从E列到G列

需要在遮光行上方添加新行

例如，如果我同时选择了单元格C5（3）和单元格E6（10），我想单击一个宏按钮，同时执行以下操作：

切割单元格A5到C5（1,2和3），并将其粘贴到A到C列下的第2行（因此A2将=1；B2将=2；C2将=3）

剪切单元格E6-G6（10、11和12）并将其粘贴到E列至G列下的第2行（因此E2将=10；F2将=11；G2将=12）

需要在遮光行的上方添加一个新行，在这种情况下，这意味着只要所有新数据都添加到第2行的顶部，就会在第4行中插入一个新的空行，第5行现在是遮光行

---

救命啊

请不要再问这样的问题了。这个网站是关于程序员帮助其他程序员发展他们的技能的。它不是为那些不能或不愿为自己编写代码的人提供免费代码

通常情况下，我会给出一些一般性的建议，但我没有尝试过像您这样的要求，我不确定这是否可行。所以我写了你的宏作为我自己的训练练习

如果你想在这里发帖，你必须学习VBA。您需要表明您已经尝试设计和编写自己的宏。在网上搜索“Excel VBA教程”，或者访问一个好的图书馆，查看他们的VBA Excel入门。有很多好的在线教程和好书，所以选择一些适合你的。学习基础知识不会花费很长时间，投入的时间会很快得到回报

一旦了解了基本知识并准备好下一个宏，就必须设计该宏。我的意思是将整个需求分解为几个小步骤。宏的第一个版本可能只应尝试步骤1。这将证明您可以在尝试步骤2之前完成步骤1。如果您对步骤1有问题，请在此处发布您的代码，并解释出现了什么问题。这就是这个网站最擅长的——帮助程序员修复错误代码。步骤1开始工作后，更新宏以完成步骤1和2。看看我的宏。看看它是如何以小步骤编写的，标题说明了每个步骤将尝试什么，后面是必要的代码。我并不是一次性编写这个宏的；我一步一步地创造了它，我只是向你推荐

我首先创建了一个符合您规范的工作表，尽管我的行数比您多。稍后我将解释为什么A9和A11为空

我对一些宏进行了编码，并将Ctrl+q设置为调用它的快捷键

我选择了单元格A7和F11。我写了足够多的宏来检查我是否能够识别我想要移动的左边和右边的单元格以及移动到哪一行。我的宏包含

Debug.Print

语句，将重要值输出到即时窗口，以便检查代码。然后我添加了代码，将正确的值移到顶部。一旦开始工作，我就从原始位置删除了复制的值。我继续编写和测试每一个小步骤，直到宏完成

宏的第一次运行将工作表更改为：

接下来我选择了A10和E6。在你的说明书中，你说两部分应该写在第2行。但是第二排已经有人了。我需要在A列中没有任何内容的情况下写入第一行，即第3行。宏中的一个早期步骤决定它将写入哪一行。单击Ctrl+q生成：

接下来我选择了A14和G14。列A中的第一个空单元格是A3，但我不想写入第3行，因为即使列A为空，该行也已被使用。标识要写入的行的代码允许这样做。单元格A9是空的，因此我可以测试代码是否正确处理了这种情况。程序设计就是识别所有这些可能性，并设计能够正确处理每种可能性的代码。不要期望在第一次尝试时想到所有的选择。在开发和测试宏的过程中，查找未计划的情况，并相应地调整设计。工作表的下一个版本如下所示：

这足以解释在给出良好指令时宏是如何运行的。请注意，宏会测试错误指令，例如仅选择一个单元格或两个单元格位于同一侧。当我键入此代码时，我意识到代码不会检查黑行上方的选定单元格。时刻准备着认识到你的设计是不完整的，并且是真实的

Option Explicit
Sub Test()

  Const ColLeftLeft As Long = 1        '\  Defines range of lefthand set
  Const ColLeftRight As Long = 3       '/
  Const ColRightLeft As Long = 5       '\  Defines range of righthand set
  Const ColRightRight As Long = 7      '/

  Dim CellSlctd() As String
  Dim Col1Slctd As Long
  Dim Col2Slctd As Long
  Dim ColTemp As Long
  Dim RowFirstBlank As Long
  Dim Row1Slctd As Long
  Dim Row2Slctd As Long
  Dim RowLeft As Long
  Dim RowRight As Long

  Debug.Print Selection.Address

  ' Selection.Address should be something like "$C$5,$E$6"
  ' Split into component cells and extract row and column numbers
  CellSlctd = Split(Selection.Address, ",")
  If UBound(CellSlctd) <> 1 Then
    Call MsgBox("Please select exactly two cells", vbOKOnly)
    Exit Sub
  End If

  Row1Slctd = Range(CellSlctd(0)).Row
  Row2Slctd = Range(CellSlctd(1)).Row
  Col1Slctd = Range(CellSlctd(0)).Column
  Col2Slctd = Range(CellSlctd(1)).Column

  Debug.Print "Cell1 (" & Row1Slctd & ", " & Col1Slctd & ")"
  Debug.Print "Cell2 (" & Row2Slctd & ", " & Col2Slctd & ")"

  ' Check one selected cell is in the lefthand column set and
  ' the other is in the righthand column set.
  If (Col1Slctd >= ColLeftLeft And Col1Slctd <= ColLeftRight And _
      Col2Slctd >= ColRightLeft And Col2Slctd <= ColRightRight) Or _
     (Col1Slctd >= ColRightLeft And Col1Slctd <= ColRightRight And _
      Col2Slctd >= ColLeftLeft And Col2Slctd <= ColLeftRight) Then
    ' Good values
  Else
    Call MsgBox("One selected cell must be within the lefthand set " & _
                "and the other must be in the righthand set", vbOKOnly)
    Exit Sub
  End If

  ' Identify which selection is the lefthand selection
  ' and which is the righthand
  If Col1Slctd >= ColLeftLeft And Col1Slctd <= ColLeftRight Then
    RowLeft = Row1Slctd
    RowRight = Row2Slctd
  Else
    RowRight = Row1Slctd
    RowLeft = Row2Slctd
  End If

  Debug.Print "Left/Right " & RowLeft & "/" & RowRight

  ' Find first blank row from top allowing for column A of a row being empty
  ' Find first blank cell in column A
  If Cells(2, "A").Value = "" Then
    ' A2 blank so probably just started
    RowFirstBlank = 2
  Else
    ' A1 and A2 not empty so jump from A1
    RowFirstBlank = Cells(1, "A").End(xlDown).Row + 1
  End If
  ' Loop until find blank row
  Do While True
    ColTemp = Cells(RowFirstBlank, ColRightRight + 1).End(xlToLeft).Column
    If ColTemp = 1 And Cells(RowFirstBlank, ColTemp).Value = "" Then
      ' Have blank row
      Exit Do
    End If
    RowFirstBlank = RowFirstBlank + 1
  Loop

 Debug.Print "FirstBlank " & RowFirstBlank

  ' Copy left and right selected sets to RowFirstBlank
  Range(Cells(RowLeft, ColLeftLeft), Cells(RowLeft, ColLeftRight)).Copy _
                                 Destination:=Cells(RowFirstBlank, ColLeftLeft)
  Range(Cells(RowRight, ColRightLeft), Cells(RowRight, ColRightRight)).Copy _
                                 Destination:=Cells(RowFirstBlank, ColRightLeft)

  ' Delete left and right selected sets
  Range(Cells(RowLeft, ColLeftLeft), _
        Cells(RowLeft, ColLeftRight)).Delete shift:=xlUp
  Range(Cells(RowRight, ColRightLeft), _
        Cells(RowRight, ColRightRight)).Delete shift:=xlUp

  ' Insert row under RowFirstBlank
  Rows(RowFirstBlank + 1).EntireRow.Insert

  ' Delete a cell from blank column to compensate for one inserted
  Cells(1, ColLeftRight + 1).Delete shift:=xlUp

  ' Place cursor in black line to ensure no accidental double run of macro
  Cells(RowFirstBlank + 3, "A").Select

End Sub