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

Question

我搜索了几个小时，但却找不到答案。如果我在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列中的任何单元格（因此，两个活动单元格）时，我需要同时进行以下操作：

1. 来自所选列C单元格的行数据（从A列到 C列）需要剪切并粘贴到下一个可用行中 表格的上半部分（上面的部分＆＃34;涂黑了＆＃34;第4行） 在这种情况下，它将是第2行，从A列到C列。
2. 来自所选列E单元格的行数据（从E列到 列G）需要剪切并粘贴到下一个可用行中 表格的上半部分（上面的部分＆＃34;涂黑了＆＃34;第4行） 在这种情况下，从第E列到第G行也是第2行。
3. 需要在黑屏行上方添加新行。

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

1. 切割细胞A5至C5（1,2＆amp; 3）并将其粘贴到A列至C列的第2行（因此A2将= 1; B2将= 2; C2将= 3）
2. 切割细胞E6-G6（10,11和12）并将其粘贴到E列至G列下的第2行（因此E2将= 10; F2将= 11;并且G2将= 12）
3. 需要在黑屏行上方添加新行，在这种情况下，只要所有新数据在第2行的顶部添加，就会在第4行和第5行插入新的空白行现在已经变黑了。

帮助！

Answer 1

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

通常我会回复一些一般的建议，但我没有尝试任何类似你的要求，我不确定是否可能。所以我把你的宏写成了我自己的训练练习。

如果您要在此处发布问题，则必须学习VBA。您需要证明您已尝试设计和编写自己的宏。在网上搜索＆＃34; Excel VBA教程＆＃34;或者访问一个好的图书馆并查看他们的VBA Excel入门。有很多很好的在线教程和许多好书，所以选择适合你的东西。学习基础知识不会花费很长时间，投入的时间会迅速回报。

一旦了解了基础知识并准备好下一个宏，就必须设计该宏。我的意思是将总需求分解为小步骤。您的宏的第一个版本应该只尝试第1步。这将证明您可以在尝试第2步之前完成第1步。如果您遇到第1步的问题，请在此处发布您的代码并解释出现了什么问题。这就是本网站最擅长的 - 帮助程序员修复他们错误的代码。步骤1工作后，更新宏以完成步骤1和2.查看我的宏。看看它是如何用微小的步骤编写的，标题说明了每个步骤将尝试的内容，然后是必要的代码。我没有一次写这个宏;我是按步骤创建的，只是我为你推荐。

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

我编写了一些宏并设置 Ctrl + q 作为调用它的快捷键。

我选择了细胞A7和F11。我写了足够多的宏来检查我是否可以识别左边的哪些单元格以及右边的哪些单元格我要移动到哪一行。我的宏包含Debug.Print语句，用于将重要值输出到立即窗口，以便我可以检查我的代码。然后我添加了代码以将正确的值移到顶部。一旦工作，我从原始位置删除了复制的值。我继续编写并测试每个小步骤，直到宏完成。

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

我接下来选择了A10和E6。在您的规范中，您说两部分应写入第2行。但第2行已被占用。我需要在第一列中写入没有任何内容的第一行。这是第3行。我的宏中的一个早期步骤决定了它要写入哪一行。单击 Ctrl + q 生成：

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

这足以解释宏给出良好指令时的操作方式。请注意，宏测试错误指令，例如只选择一个单元格或两个单元格位于同一侧。当我键入它时，我意识到代码不会检查选定的单元格位于黑色行上方。始终准备好实现您的设计不完整并准备好进行调整。我将离开你的任务是检查两个选定的单元格是否在黑色行下面，

欢迎使用StackOverflow和编程的乐趣。祝好运。

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