Question

我有两组列。其中一列是另一组的。我想写一个宏比较它们，如果它们不相等，则将第二个插入第一个。算法颂歌：

if (code-1)<>(code-2) AND (serial-1)<>(serial-2) AND (amount-1)<>(amount-2) then
 (code-1)==(code-2) AND (serial-1)==(serial-2) AND (amount-1)==(amount-2)

我想要插入行标记。

我的表格如下：

code-1  serial-1    amount-1    code-2  serial-2    amount-2
1         11          111          1      11          111
3         33          333          1      11           11
                                   2      22           22
                                   3      33           33
                                   3      33          333

我要找的结果如下：

code-1  serial-1    amount-1    code-2  serial-2    amount-2
   1     11           111          1      11          111
   3     33           333          1      11          11
   1     11           11           2      22          22
   2     22           22           3      33          33
   3     33           33           3      33         333

Answer 1

更新

这个新代码将创建2个辅助列来运行vlookup以消除当宏运行以选择要复制的单元格时所有与标准不匹配的列，并在完成后删除这2列。

但是，我根据你给我的内容编写了代码，所以只有在安排时，A到C列和D到F列

才会有效。

如果有效，请记得将此代码标记为非常赞赏的答案=]

新代码：

Sub yoursub()

Dim lstr1        As Long
Dim lstr2        As Long
Dim mark1        As Long

lstr2 = Sheets(1).Cells(Rows.Count, 4).End(xlUp).Row

lstr1 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row + 1

mark1 = lstr1 - 1

Range("A1").EntireColumn.Insert
Range("A1").EntireColumn.Insert

For i = 2 To mark1

Cells(i, 2) = Cells(i, 3) & "-" & Cells(i, 4) & "-" & Cells(i, 5)

Next

For j = 2 To lstr2

Cells(j, 1).FormulaR1C1 = "=VLOOKUP(RC[5]&""-""&RC[6]&""-""&RC[7],C[1],1,FALSE)"

Next

For j = 2 To lstr2

If WorksheetFunction.IfError(Cells(j, 1), "Error") = "Error" Then

Range(Cells(j, 6), Cells(j, 8)).Copy
Cells(lstr1, 3).PasteSpecial xlPasteValues
lstr1 = Sheets(1).Cells(Rows.Count, 3).End(xlUp).Row + 1

End If

Next

Range("A1").EntireColumn.Delete
Range("A1").EntireColumn.Delete

End Sub

如果相应列的值不相等则比较行

1 个答案: