Vba 如果excel单元格与行中的其他单元格匹配，如何自动删除和排序excel单元格

本表共6列，其中B列为A列的答案 这是一道选择题，在c、d、e、f栏中有四个选项

我希望B列保持不变>在B1中搜索并从C1 D1 E1和F1中删除任何找到的结果>然后进行排序，以便只存在C1 D1和E1，并删除F1

像

A1问题的正确答案在B1和c1中。我希望删除C1并对第1行中的其余单元格进行排序，以便d1（爱的诗人）移动到C1，e1移动到d1，f1移动到e1

同样地

a2问题的正确答案在b2单元格和e2单元格中

我希望e2的数据被删除，f2的数据移动到e2

---

谢谢

这应该能帮到你

   Sub TableExample()
    Dim lastrow As Long
    Dim address As String
    With ActiveSheet
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim r As Range: Set r = .Range("A1", "A" & lastrow)
    End With
    For Each cell In r.Cells
        For i = 1 To 4
            If cell.Offset(0, 1).Value = cell.Offset(0, 1 + i).Value Then
                address = cell.Offset(0, 1 + i).address(0, 0)
                Exit For
            Else
                address = "0"
            End If
        Next
        If address <> "0" Then
            Dim rr As Range: Set rr = ActiveSheet.Range(address)
            For i = 1 To 4
                rr.Value = rr.Offset(0, 1).Value
                Set rr = rr.Offset(0, 1)
            Next
        End If
    Next
End Sub

子表示例（）
最后一排一样长
作为字符串的Dim地址
使用ActiveSheet
lastrow=.Cells（.Rows.Count，“A”）.End（xlUp）.Row
尺寸r作为范围：设置r=.Range（“A1”、“A”和lastrow）
以
对于r.单元格中的每个单元格
对于i=1到4
如果cell.Offset（0,1）.Value=cell.Offset（0,1+i）.Value，则
地址=单元偏移量（0，1+i）。地址（0，0）
退出
其他的
地址=“0”
如果结束
下一个
如果地址为“0”，则
将rr设置为范围：设置rr=ActiveSheet.Range（地址）
对于i=1到4
rr.Value=rr.Offset（0,1）.Value
设置rr=rr偏移量（0，1）
下一个
如果结束
下一个
端接头

哦，我发现问题出在“SheetName=“Sheet1”中，因为我的文档没有名为“Sheet1”的工作表，我将名称改为“ETC”“成功了！相应地更改图纸名称。告诉我它是否有效！我是excel VBA新手，很想知道是否有办法进一步实现自动化。好像我的医生里有几张纸。所有这些都是类似类型的数据，需要实现。因为每次我想在我的文档上执行此操作时，都必须更改工作表名称。你能设法绕过这个名称更改吗？比如，当我在一张名为“诗人”的工作表上，运行宏时，它会自动选择该工作表？我只是好奇！它应该在激活的工作表上执行您想要的操作。投赞成票，如果它工作：）是的，它工作，除了这个版本有一个小错误，你忘了添加“结束子”超级工作！！！！