Excel写个VBA谁会？

Question

在Excel的sheet1表中，A4：O4这行数如果与A5：O6行中数字有重复就把该行重复的数字放在q4:Z4行，同样A5：O5这行数如果与A6：O7行中数字有重复就把该行重复的数字放在q5:Z5行，A列至O列的数字每行数字都进行这样的操作，并且得到的结果每4行中有 重复的数字，把结果在另一行写出来，我问了很多人写的程序都有BUG，哪位大神给写一下

Answer 1

以下是实现该功能的VBA代码：
Sub FindDuplicate()
Dim i As Long, j As Long, k As Long
Dim rng1 As Range, rng2 As Range
Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1") '指定操作的工作表

For i = 5 To 20 Step 4 '循环遍历每4行数据
Set rng1 = ws.Range("A" & i & ":O" & i) '获取当前行的数据范围
For j = i + 1 To i + 3 '循环遍历当前行的下一行到下三行
Set rng2 = ws.Range("A" & j & ":O" & j) '获取下一行到下三行的数据范围
For k = 17 To 1 Step -1 '从O列开始往前遍历
If rng1.Cells(1, k) = rng2.Cells(1, k) Then '判断是否有重复数字
ws.Range("Q" & i) = rng1.Cells(1, k) '将重复数字放在Q:Z列
ws.Range("R" & i) = rng1.Cells(1, k)
ws.Range("S" & i) = rng1.Cells(1, k)
ws.Range("T" & i) = rng1.Cells(1, k)
ws.Range("U" & i) = rng1.Cells(1, k)
ws.Range("V" & i) = rng1.Cells(1, k)
ws.Range("W" & i) = rng1.Cells(1, k)
ws.Range("X" & i) = rng1.Cells(1, k)
ws.Range("Y" & i) = rng1.Cells(1, k)
ws.Range("Z" & i) = rng1.Cells(1, k)
Exit For '找到一个重复数字就退出循环
End If
Next k
Next j
Next i

'将结果在另一行输出
For i = 4 To 20 Step 4
Set rng1 = ws.Range("Q" & i & ":Z" & i)
Set rng2 = ws.Range("A" & i & ":O" & i)
For j = 1 To 10
If WorksheetFunction.CountIf(rng1, rng2.Cells(1, j)) > 1 Then
ws.Cells(22, j) = rng2.Cells(1, j)
End If
Next j
Next i
End Sub
这个代码首先使用循环遍历每四行数据，对于每一行，再使用循环遍历当前行的下一行到下三行，判断是否有重复数字。如果有重复数字，就将这些数字放在Q:Z列。最后，再遍历每四行数据的结果，统计出重复的数字，并将结果在第22行输出。

Answer 2

要实现这个功能，您可以使用Excel的公式。以下是一个解决方案，您可以根据需要修改单元格范围：

在Q4单元格中输入以下公式：

=IF(ISNUMBER(MATCH(A4, A5:O6, 0)), A4, "")

这个公式会检查A4单元格中的数字是否在A5:O6范围内，如果有重复，则将A4的值放在Q4单元格中，否则为空。

选中Q4单元格，将其复制，然后选择R4:Z4范围，粘贴公式。这将检查B4:O4中的其他数字。

选中Q4:Z4范围，将其复制，然后选择Q5:Z5范围，粘贴公式。这将检查A5:O5与A6:O7范围的重复数字。

按照上述方法，将公式向下扩展，以检查所有行的重复数字。

在AA4单元格（或您选择的任何其他列）中输入以下公式，以显示每四行重复数字的结果：

=IF(MOD(ROW(),4)=0, TEXTJOIN(", ",TRUE,Q4:Z4), "")

这个公式会检查当前行号是否可以被4整除，如果可以，则将Q4:Z4范围内的重复数字用逗号分隔的形式显示出来。否则，单元格将为空。

将AA4单元格的公式向下扩展，以获取每四行的结果。

这样，您将在Q:Z列中看到每行与下两行比较的重复数字，并在AA列中看到每四行的结果。您可以根据需要调整行和列的范围。

追问

没有结果

Answer 3

以下为实现该功能的Excel公式：
在Q4单元格中输入以下公式，然后将其拖拽至R4:Z4中：
```
=IF(COUNTIF($A$5:$O$6,$A4)>0,TEXTJOIN(",",TRUE,$A4:$O4),"")
```
在Q5单元格中输入以下公式，然后将其拖拽至R5:Z5中：
```
=IF(COUNTIF($A$6:$O$7,$A5)>0,TEXTJOIN(",",TRUE,$A5:$O5),"")
```
将以上两个公式整行复制，粘贴到需要进行操作的每四行对应的Q、R、S、T、U、V、W、X、Y、Z列中。
最后，在AA4单元格中输入以下公式，并将其拖拽下去至需要显示结果的所有行：
```
=TEXTJOIN(",",TRUE,Q4:Z4)
```
这样就可以实现按照要求把重复数字放在指定位置并输出结果的功能了。

Answer 4

以下是一个可以解决这个问题的VBA程序代码，请将其放置在Excel的VBA编辑器中：
Sub FindDuplicates()
Dim lastRow As Long
Dim i As Long, j As Long, k As Long
Dim arr1 As Variant, arr2 As Variant
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

' 设定最後一行
lastRow = Cells(Rows.Count, "A").End(xlUp).Row

' 逐行搜寻
For i = 5 To lastRow Step 4
' 将搜寻范围储存到变数中
arr1 = Range("A" & i & ":O" & i).Value
arr2 = Range("A" & i + 1 & ":O" & i + 1).Value

' 逐个元素比较
For j = LBound(arr1, 2) To UBound(arr1, 2)
For k = LBound(arr2, 2) To UBound(arr2, 2)
' 如果有重复的数字，就将其储存到字典中
If arr1(1, j) = arr2(1, k) Then
dict(arr1(1, j)) = 1
Exit For
End If
Next k
Next j

' 将字典中的元素写入结果储存列
If dict.Count > 0 Then
Range("Q" & i / 4 + 3 & ":Z" & i / 4 + 3).Value = dict.keys
Set dict = CreateObject("Scripting.Dictionary")
End If
Next i
End Sub
这个程序代码会逐行搜寻指定范围的数字，并将重复的数字储存到一个字典中。最后，将字典中的元素写入结果储存列。注意，在字典中，每个元素只会储存一次。此外，程序代码还假定您的表格是从第五行开始且每四行为一组。如果这不是您的情况，请将程序代码中的相应行数更改为适当的值。追问

你写的代码不能用

Answer 5

Sub CheckDuplicates()

Dim i As Long, j As Long, k As Long
Dim range1 As Range, range2 As Range, range3 As Range

'设置第一个比较的范围
Set range1 = Range("A4:O4")

'循环比较每一行的数据
For i = 4 To 65536 Step 4
Set range2 = Range("A" & i + 1 & ":O" & i + 2)
Set range3 = Range("Q" & i & ":Z" & i)
For j = 1 To range1.Columns.Count
For k = 1 To range2.Columns.Count
'判断是否有重复的数字
If range1.Cells(1, j) = range2.Cells(1, k) Then
'把重复的数字放到指定的位置
range3.Cells(1, k) = range1.Cells(1, j)
End If
Next k
Next j
Set range1 = range2
Next i

'把结果在另一行输出
For i = 4 To 65536 Step 4
Set range1 = Range("A" & i & ":O" & i)
Set range2 = Range("A" & i + 3 & ":O" & i + 3)
Set range3 = Range("Q" & i & ":Z" & i)
For j = 1 To range1.Columns.Count
For k = 1 To range2.Columns.Count
'判断是否有重复的数字
If range1.Cells(1, j) = range2.Cells(1, k) Then
'把重复的数字放到指定的位置
range3.Cells(1, k) = range1.Cells(1, j)
End If
Next k
Next j
Next i

End Sub

使用方法：

在Excel中打开需要进行操作的文件，按下 Alt + F11 打开VBA编辑器。

在左侧的 Project - VBAProject 中，双击需要进行操作的表格的名称，打开代码编辑窗口。

将以上代码复制并粘贴到编辑窗口中。

按下 F5 运行代码，程序将自动完成操作。

注意：以上代码可能会影响到其他表格的数据，使用前请备份数据。