excel - Excel宏查找文本值剪切和粘贴然后向上移动单元格

Question

我有一个噩梦般的任务，要从一个会计包迁移到另一个。

我在 A、B 和 G 列中有 9340 行，需要以某种方式排序，然后才能被新系统导入。

前：

后：

我运行了一个宏，它可以满足我的需求，但仅适用于选定的范围。如何使宏适用于整个工作表？

Sub Macro1()

  Range("B206").Select
  Selection.Cut
  Range("A207").Select
  ActiveSheet.Paste
  Rows("206:206").Select
  Selection.Delete Shift:=xlUp
  Range("A206").Select
  Selection.Copy
  Range("A206:A216").Select
  ActiveSheet.Paste
  Range("C216").Select
  Application.CutCopyMode = False
  Selection.Cut
  Range("G216").Select
  ActiveSheet.Paste
End Sub

Answer 1

这可能会在某些方面失败。您的设置比我有时间重新创建更复杂。请在您的数据副本上运行此代码。它基本上移动了东西，然后删除了 B 列中所有有空格的行。您应该删除第一个“Opening”行上方的标题垃圾：

Sub test()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim cell As Excel.Range

Set ws = ActiveSheet
With ws
LastRow = .Range("B" & .Rows.Count).End(xlUp).Row
For Each cell In .Range("B1:B" & LastRow)
    If Left(cell.Value, Len("Opening")) = "Opening" Then
        cell.Offset(1, -1).Value = cell.Value
        cell.ClearContents
    Else
        cell.Offset(0, -1) = cell.Offset(-1, -1).Value
    End If
    If Left(cell.Value, Len("Closing")) = "Closing" Then
        cell.Offset(0, 6).Value = cell.Offset(0, 1).Value
        cell.Offset(0, 1).ClearContents
    End If
Next cell
    .Range("B" & .Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub