通过使用剪切+插入方法匹配第一个元素来对齐行

Question

如何剪切和插入匹配的行(通过共享的第一个元素条件(？

此问题是"通过匹配第一个元素对齐行">问题的扩展。在意识到VBA允许程序员剪切+插入时，很明显我错误地构建了问题。但是，我确实破坏了试图实现这个想法的代码。必须有一种方法可以简化rmatch函数下方和嵌套删除行循环上方的行，以实现目标 - 我只是不知道如何。

With wsR
For r = startRow To wsR.Cells(.Rows.Count, t1s).End(xlUp).Row
If Application.WorksheetFunction.CountIf(.Columns(t2s), wsR.Cells(r, t1s).Value) > 0 Then

rMatch = Application.WorksheetFunction.Match(.Cells(r, t1s).Value, .Columns(t2s), 0)

.Range(wsR.Cells(rMatch + 1, t2s), wsR.Cells(rMatch + 1, t2s + t2l)).Insert shift:=xlDown
.Range(wsR.Cells(rMatch + 1, t2s), wsR.Cells(rMatch + 1, t2s + t2l)).Value2 = "*"

.Range(wsR.Cells(rMatch, t1s), wsR.Cells(rMatch, t1s + t1l)).Insert shift:=xlDown
'.Range(wsR.Cells(rMatch + 1, t1s), wsR.Cells(rMatch + 1, t1s + t1l)).Value2 = "*"
.Range(wsR.Cells(rMatch, t1s), wsR.Cells(rMatch, t1s + t1l)).Value2 = .Range(wsR.Cells(r + 1, t1s), wsR.Cells(r + 1, t1s + t1l)).Value2

r = r + 1

'If .Cells(r, t1s).Value <> .Cells(r, t2s) Then
'.Range(wsR.Cells(rMatch + 1, t2s), wsR.Cells(rMatch + 1, t2s + t2l)).Insert shift:=xlDown
'.Range(wsR.Cells(rMatch + 1, t2s), wsR.Cells(rMatch + 1, t2s + t2l)).Value2 = "*"
'End If

If wsR.Cells(r, t1s).Value = "*" & wsR.Cells(r, t2s).Value = "*" Then
wsR.Cells(r, "A").EntireRow.Delete
End If

End If
Next r
End With

任何建议将不胜感激。

Answer 1

更新 2

With wsR
For r = startRow To wsR.Cells(.Rows.Count, t1s).End(xlUp).Row
If Application.WorksheetFunction.CountIf(.Columns(t2s), wsR.Cells(r, t1s).Value) > 0 Then
rMatch = Application.WorksheetFunction.Match(.Cells(r, t1s).Value, .Columns(t2s), 0)

.Range(.Cells(r - 1, t2s), .Cells(r - 1, t2s + t2l)).Insert shift:=xlDown
.Range(.Cells(rMatch + 1, t2s), .Cells(rMatch + 1, t2s + t2l)).Cut
.Select
.Range(.Cells(r, t2s), .Cells(r, t2s + t2l)).Select
.Paste
.Range(.Cells(rMatch + 1, t2s), .Cells(rMatch + 1, t2s + t2l)).Delete
End If
Next r
End With

所以我在这里所做的是：

在表

1. 2上插入空白单元格，与表1中的所需值在同一行上
2. 切割表 2 中的单元格。
3. 将它们粘贴到空白单元格中。
4. 删除现在为空白的旧单元格。