如何使用VBA在excel中排列表格？

Question

我正在尝试使用 VBA 对齐 Excel 中的两个表格。

基本上我有：

 Table 1                 Table 2              
7 columns               7 columns 

在表 2 中，表 1 中缺少一些行！

我在下面使用了这个 VBA，但它不起作用，因为在我的表格中我有 7 列。即使我的第二个表中缺少某些行，我也需要确保两个表的 7 列都匹配。

Sub Macro1()
    Dim rng1 As Range
    Set rng1 = Range([a1], Cells(Columns.Count, "A").End(xlUp))
    rng1.Offset(0, 1).Columns.Insert
    With rng1.Offset(0, 1)
        .FormulaR1C1 = _
        "=IF(ISNA(MATCH(RC[-1],C[1],0)),"""",INDEX(C[1],MATCH(RC[-1],C[1],0)))"
        .Value = .Value
    End With
End Sub

任何想法，我会附上一张图片，但这是我第一次使用 Stackoverflow 哈哈！

Answer 1

虽然这个答案确实包含了一些代码，但更关心的是教你如何自己编写类似的宏。

我现在应该说我不赞成我的代码：

• 我的宏不检查表 2。如果表 2 包含表 1 中不存在的行，我的宏将移动该行及其下方的任何行，向下留下一个很大的间隙。
• 在原地更新这样的数据是不好的做法。如果出现任何问题，数据将被部分更改。您可能必须从原始工作簿的备份重新开始。最好创建一个新工作表并根据需要复制数据以创建您想要的外观。

您有找到工作表最后一行的代码，但以下代码更简单且同样可靠：

With Worksheets("Data")
  RowExistLast = .Cells(Rows.Count, ColExistId).End(xlUp).Row
End With

对活动工作表进行操作很少是一个好主意。例如，如果用户在激活错误的工作表的情况下启动宏，则该工作表将被损坏。我的代码将在指定的工作表上运行，即使它不活动。

您需要检查表 1 中的每一行。下面的代码将表 1 中每一行的 Id 列的内容输出到即时窗口。如果您运行此代码，除了最后 200 行左右之外的所有行都将滚动到窗口顶部：

  With Worksheets("Data")
    RowExistLast = .Cells(Rows.Count, ColExistId).End(xlUp).Row
    For RowExistCrnt = RowDataFirst To RowExistLast
      Debug.Print .Cells(RowExistCrnt, ColExistId).Value
    Next
  End With

我无法使用For 循环来降级表 2。循环的结束值不能在循环内更改，但我们将插入行。 Do While 循环是必要的：

RowNewCrnt = RowDataFirst
Do While RowNewCrnt <= RowNewLast
  :
  ' If row inserted
  RowNewLast = RowNewLast + 1
  :
  ' With For loop, control variable is stepped automatically.
  ' With Do loop, you must step it as necessary.
  :
  RowNewCrnt = RowNewCrnt + 1
Next

因为我试图对齐两个表中的行，所以我不需要为表 2 设置单独的循环，并且我只需要一个用于两个表的行变量。

在我的宏中，我检查了两个表的 Id 列，并在不匹配时将部分行插入到表 2 中。所以：

A        A
B        B
C        D
D        

变成：

A        A
B        B
C
D        D

您可能希望通过将值从表 1 的标题列（列 A:B）移动到表 2 的标题列 (J:K) 并将值列 (L) 设置为零，但我没有为您提供此代码。

我希望任何 VBA 程序员都能很快熟悉 For 循环等，但插入部分行并不是我每天都要做的事情，因此我手头没有必要的语法。我打开宏记录器，插入部分行，关闭宏记录器并检查它创建的代码：

Sub Macro1()
'
' Macro1 Macro
' Macro recorded 14/10/2014 by Tony Dallimore
'

'
    Range("J7:L7").Select
    Selection.Insert Shift:=xlDown
End Sub

这是语法正确的 VBA，但不是好的 VBA。选择单元格或范围很少是好的做法。两个key语句可以替换为：

    Range("J7:L7").Insert Shift:=xlDown

"J7:L7" 只是一个我可以在运行时构建的字符串：

    .Range(ColNewFirst & RowBothCrnt & ":" & ColNewLast & RowBothCrnt).Insert Shift:=xlDown

上面我已经介绍了下面宏的所有元素。如有必要，请提出问题，但您自己破译此代码的次数越多，您的开发速度就越快。

' Look up this statement to read why its inclusion is a good idea
Option Explicit
Sub AlignRows()

  ' Using constants instead of literals has the following effects:
  '  * It takes a little longer to type your macro.
  '  * It makes your macro self-documenting.
  '  * If new header rows or data columns are added, amending the constants
  '    will fix the macro.
  Const ColExistId As String = "A"
  Const ColNewId As String = "J"
  Const ColNewFirst As String = "J"
  Const ColNewLast As String = "L"
  Const RowDataFirst As Long = 6

  Dim RowBothCrnt As Long
  Dim RowExistLast As Long

  ' I do not know the name of your worksheet.  Replace "Data" with your worksheet name
  With Worksheets("Data")

    RowExistLast = .Cells(Rows.Count, ColExistId).End(xlUp).Row

    For RowBothCrnt = RowDataFirst To RowExistLast
      If .Cells(RowBothCrnt, ColExistId).Value <> _
         .Cells(RowBothCrnt, ColNewId).Value Then
        .Range(ColNewFirst & RowBothCrnt & ":" & _
               ColNewLast & RowBothCrnt).Insert Shift:=xlDown
      End If
    Next

  End With

End Sub