EXCEL VBA的代码问题？

Question

在每一行中，B,E,H,K,N,Q这六列所对应的的单元格里。
如果6个单元格中，没有相同的数据，那么删除这一行。
如果6个单元格中，有多项或多个相同的数据，另有1个不相同的数据，那么就把这1个不相同的数据清除。保留相同的数据。
这个代码应该怎么写啊？

Answer 1

我建议你按照以下的步骤来解决你的问题：

定义变量。你需要定义一些变量来存储你需要操作的数据和范围，比如行数、列数、单元格值等。这样做是为了让你的代码更清晰和易懂，也方便后续的修改和调试。

循环遍历。你需要使用For循环或者Do While循环来遍历每一行的数据，判断每一行是否满足删除或清除的条件。这样做是为了让你的代码更灵活和高效，也避免遗漏或重复操作。

判断条件。你需要使用If语句或者Select Case语句来判断每一行中B,E,H,K,N,Q这六列所对应的单元格是否有相同或不同的数据，并执行相应的操作。这样做是为了让你的代码更准确和完善，也符合你的需求和逻辑。

执行操作。你需要使用Delete方法或者ClearContents方法来删除或清除不符合条件的行或单元格。这样做是为了让你的代码更简洁和有效，也达到你想要的结果。

下面是一个可能的代码示例：

Sub 删除或清除()
'定义变量
Dim i As Long '行号
Dim j As Long '列号
Dim k As Long '计数器
Dim v As Variant '单元格值
Dim r As Range '操作范围

'设置操作范围为A1:Q1000（根据实际情况修改）
Set r = Range("A1:Q1000")

'从最后一行开始往上循环
For i = r.Rows.Count To 1 Step -1
'初始化计数器为0
k = 0
'初始化单元格值为空
v = ""
'循环遍历B, E,H, K,N, Q这六列
For Each j In Array(2, 5, 8, 11, 14, 17)
'如果单元格值为空，则跳过
If r.Cells(i, j).Value = " Then GoTo NextCell
'如果单元格值与之前不同，则计数器加1，并记录单元格值
If r.Cells(i, j).Value <> v Then
k = k + 1


v = r.Cells(i, j).Value
End If
NextCell:
Next j
'判断计数器的值
Select Case k
Case 0 '如果计数器为0，说明六个单元格都为空，删除该行
r.Rows(i).Delete
Case 1 '如果计数器为1，说明六个单元格都相同，不做操作
'Do nothing
Case 2 '如果计数器为2，说明有五个单元格相同，一个不同，清除不同的单元格
'重新循环遍历B,E,H,K,N,Q这六列
For Each j In Array(2, 5, 8, 11, 14, 17)
'如果单元格值与之前不同，则清除该单元格
If r.Cells(i, j).Value <> v Then
r.Cells(i, j).ClearContents
End If
Next j
Case Else '如果计数器大于2，说明有多项或多个不同的数据，删除该行
r.Rows(i).Delete
End Select
Next i
End Sub

我来完整地解析一遍代码的逻辑：

首先，定义了一些变量，用来存储行号、列号、单元格值、操作范围等数据。

然后，设置了操作范围为A1:Q1000，这个范围可以根据实际情况修改。

接着，从最后一行开始往上循环遍历每一行的数据，这样可以避免删除行后影响行号的变化。

对于每一行，初始化计数器为0，用来记录有多少个不同的数据；初始化单元格值为空，用来记录第一个不为空的数据。

再对于每一行，循环遍历B,E,H,K,N,Q这六列所对应的单元格，如果单元格为空，则跳过；如果单元格值与之前不同，则计数器加1，并记录单元格值。

然后，根据计数器的值判断该行是否满足删除或清除的条件，如果计数器为0，说明六个单元格都为空，删除该行；如果计数器为1，说明六个单元格都相同，不做操作；如果计数器为2，说明有五个单元格相同，一个不同，清除不同的单元格；如果计数器大于2，说明有多项或多个不同的数据，删除该行。

最后，结束循环，完成操作。

这就是代码的逻辑和功能。希望对你有帮助。

追问

非常感谢老师
For Each j In Array(2, 5, 8, 11, 14, 17)
这句话 ：for each 控件变量必须为变体或对象

Answer 2

以下是一个Python代码示例，可以实现您所描述的操作：
# 假设您有一个二维列表 data，包含了需要处理的数据
# 列表中的每个元素都是一个包含 7 个元素的列表
# 其中第 2、5、8、11、14、17 列对应 B、E、H、K、N、Q 这六列
result = []
for row in data:
values = [row[1], row[4], row[7], row[10], row[13], row[16]] # 提取需要比较的 6 个单元格的数据
if len(set(values)) == 6: # 如果没有相同的数据，就保留这一行
result.append(row)
elif len(set(values)) == 5: # 如果有 1 个不相同的数据，就把它清除，保留相同的数据
for i in range(6):
if values.count(values[i]) > 1:
row[1 + 3 * i] = values[i]
break # 只替换第一个找到的重复值
result.append(row)
# 处理完所有行之后，result 中就只包含符合条件的行了追问

能不能用EXCEL啊？

Answer 3

可以尝试使用如下的 VBA 代码实现该功能：
Sub CleanData()
Dim lastRow As Long
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row ' 获取最后一行的行号
Dim i As Long
For i = lastRow To 2 Step -1 ' 从最后一行开始往上遍历到第二行
Dim values(5) As Variant ' 存储要比较的六个单元格的数据
values(0) = Cells(i, "B").Value
values(1) = Cells(i, "E").Value
values(2) = Cells(i, "H").Value
values(3) = Cells(i, "K").Value
values(4) = Cells(i, "N").Value
values(5) = Cells(i, "Q").Value
Dim j As Long
For j = 0 To 4 ' 比较六个单元格中的数据，查找是否有重复项
If Not IsEmpty(values(j)) And values(j) <> "" Then
Dim k As Long
For k = j + 1 To 5
If Not IsEmpty(values(k)) And values(k) <> "" Then
If values(j) = values(k) Then
If values(5 - j - k) <> values(j) Then
Cells(i, 5 - j - k).ClearContents ' 如果有重复项但是另外一个单元格中的数据不同，则清除那个单元格中的数据
Exit For ' 找到重复项就退出内层循环
End If
End If
End If
Next k
End If
Next j
' 如果六个单元格中的数据都不同，那么删除这一行
If IsEmpty(values(0)) And IsEmpty(values(1)) And IsEmpty(values(2)) And IsEmpty(values(3)) And IsEmpty(values(4)) And IsEmpty(values(5)) Then
Rows(i).Delete
End If
Next i
End Sub追问

If values(5 - j - k) values(j)，老师，这句下标越界啊

Answer 4

有删除行，用逆序处理。有判断数据相同，用字典处理。具体得上文件沟通。

删除沟通，对不对