0

我正在尝试完成一项小型数据清理任务，并希望使用 Excel VBA 而不是我常用的 Python。

我在每一行的列上都有项目列表。不幸的是，我需要删除这些列表中的重复项目。可以假设每个列表最多只有约 15 个项目。

我对伪代码的尝试

Foreach row in selection:
Check Column n and n+1. (so thats column A and B for the first iteration)
If different, n++
If the same, remove the cell N+1 and shift all values to the right right of N+1 left 1 cell.
Check (n, n+1) again after.

我附上了一些示例行。任何帮助将不胜感激 - 不幸的是，我发现 VBA 比我迄今为止处理的任何其他语言都更难。

下面的所有三行都应该减少到相同的东西。

1 苹果香蕉巧克力狗
2 苹果香蕉巧克力 巧克力巧克力狗
3 苹果香蕉巧克力 巧克力巧克力 巧克力巧克力狗 狗 狗

这三个例子都应该归结为

苹果香蕉巧克力狗

4

1 回答 1

2

当然可以，

在 Excel 工作表的某处放置一个命令按钮，并将此代码放入 VBA 编辑器中：

Private Sub CommandButton1_Click()
    RecurseRows 'Start recursion
End Sub

Private Sub RecurseRows(Optional row As Long = 1)
    RecurseColumns row, 1, 2

    If (row = ActiveSheet.Range("A65536").End(xlUp).row) Then
        Exit Sub 'End recursion when next row is empty
    Else
        RecurseRows row + 1 'next row
    End If
End Sub

Private Sub RecurseColumns(row As Long, col1 As Long, col2 As Long)
    If (IsEmpty(ActiveSheet.Cells(row, col2))) Then
        Exit Sub 'End recursion
    Else
        If (ActiveSheet.Cells(row, col1) = ActiveSheet.Cells(row, col2)) Then
            ActiveSheet.Cells(row, col2).Delete xlShiftToLeft 'Remove duplicate
            RecurseColumns row, col1, col2 'Check same couple again, since col2 has changed
        Else
            RecurseColumns row, col2, col2 + 1 'Shift one cell to the right
        End If
    End If
End Sub

当然你也可以反复做... XD

于 2013-07-16T09:21:46.580 回答