如何使用VBA在Excel中排列表？

我正在尝试使用VBA在Excel中alignment两个表。

基本上我有：

Table 1 Table 2 7 columns 7 columns 

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

我在下面使用了这个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

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

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

• 我的macros不检查表2.如果表2包含表1中不存在的行，我的macros将移动该行，并在其下的任何一行，留下一个非常大的差距。
• 现场更新数据是不好的做法。 如果出现任何问题，数据将被部分更改。 您可能不得不重新开始原始工作簿的备份。 最好创build一个新的工作表，并根据需要复制数据以创build您所寻求的外观。

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

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

在活动工作表上操作几乎不是一个好主意。 例如，如果用户启动错误工作表激活的macros，该工作表将被损坏。 我的代码将在指定的工作表上运行，即使它不是活动的。

您需要检查表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 

因为我试图alignment两个表中的行，所以我不需要表2的单独的循环，我只需要两个表的一个行variables。

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

 AA BB CD D 

变为：

 AA BB C DD 

您可能希望通过将表1的列标题列（列A：B）中的值移动到表2的标题列（J：K）并将值列（L）设置为零来构build行，但是I没有提供这个代码给你。

我希望任何VBA程序员都能快速熟悉For循环等，但插入部分行不是我每天都在做的事情，所以我没有必要的语法在我的指尖。 我打开macroslogging器，插入一个部分行，closuresmacroslogging器，并检查它创build的代码：

 Sub Macro1() ' ' Macro1 Macro ' Macro recorded 14/10/2014 by Tony Dallimore ' ' Range("J7:L7").Select Selection.Insert Shift:=xlDown End Sub 

这在语法上是正确的VBA，但不是很好的VBA。 select单元格或范围很less见。 两个关键语句可以replace为：

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

"J7:L7"只是我可以在运行时build立的一个string：

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

以上我已经介绍了下面macros的所有元素。 如果有必要的话可以回答一些问题，但是你可以自己破译这些代码的越多，你开发得越快。

 ' 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