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 CompareAndMove()
Dim CompareRow As Integer
Dim CurrentRow As Integer
Dim DuplicateCount As Integer
Dim DuplicateString As String

For CompareRow = 4 To 21 Step 2
For CurrentRow = CompareRow + 1 To CompareRow + 2
DuplicateCount = 0
DuplicateString = ""
For i = 1 To 15
If Cells(CompareRow, i) = Cells(CurrentRow, i) Then
DuplicateCount = DuplicateCount + 1
DuplicateString = DuplicateString & Cells(CompareRow, i) & ", "
End If
Next i
If DuplicateCount > 0 Then
Range("Q" & CurrentRow - 3 & ":Z" & CurrentRow - 3).Value = DuplicateString
End If
Next CurrentRow
Next CompareRow

'Check for overall duplicates
For i = 4 To 21 Step 4
DuplicateCount = 0
DuplicateString = ""
For j = 1 To 15
If Cells(i, j) = Cells(i + 1, j) Or Cells(i, j) = Cells(i + 2, j) Or Cells(i, j) = Cells(i + 3, j) Then
DuplicateCount = DuplicateCount + 1
DuplicateString = DuplicateString & Cells(i, j) & ", "
End If
Next j
If DuplicateCount > 0 Then
Range("A22").Offset(0, i - 4).Value = DuplicateString
End If
Next i

End Sub

这个程序将在第21行中显示重复项。请注意，此程序假定输入始终是20行，其中每4行有一个重复项，并且数据是从A1开始的。如果将来的数据具有不同的格式，请相应地修改代码追问

运行不了

Answer 2

Excel VBA是一种编程语言，用于创建宏，实现Excel自动化操作。如果你需要写Excel VBA程序，你需要具备以下几个方面的知识：

1. Visual Basic for Applications（VBA）语言基础；
2. Excel对象模型（如Workbook、Worksheet、Range等）；
3. 控制流语句（如If、While、For等）；
4. 过程、函数和变量的定义和调用；
5. VBA中常用的函数和方法；
6. VBA常规错误处理。

如果你初学者或者没有专业的编程基础，可以考虑参加Excel VBA的培训课程或者学习相关的书籍和在线教程。如果你拥有编程经验，可以使用Excel内置的VBA编辑器来编写和调试代码。无论如何，学习Excel VBA需要时间和耐心，通过不断尝试和练习，你会逐渐掌握这种编程语言的使用方法。

Answer 3

以下是可以实现这个VBA的代码
Sub findDuplicates()
Dim lastRow As Long, i As Long, j As Long, k As Long
Dim sheet As Worksheet
Set sheet = ThisWorkbook.Sheets("Sheet1")

lastRow = sheet.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lastRow Step 4
For j = i To i + 2
For k = j + 1 To i + 3
If Not Intersect(sheet.Range("A" & j & ":O" & j), sheet.Range("A" & k & ":O" & k)) Is Nothing Then
sheet.Range("Q" & j & ":Z" & j).Value = Union(sheet.Range("Q" & j & ":Z" & j), sheet.Range("A" & k & ":O" & k)).Value
sheet.Range("Q" & k & ":Z" & k).Value = Union(sheet.Range("Q" & k & ":Z" & k), sheet.Range("A" & j & ":O" & j)).Value
End If
Next k
Next j
Next i

lastRow = sheet.Cells(Rows.Count, 1).End(xlUp).Row
Dim rowResult As Long
rowResult = lastRow + 2
For i = 4 To lastRow Step 4
For j = i To i + 3
If Not sheet.Range("Q" & j & ":Z" & j).Value = "" Then
sheet.Range("A" & rowResult & ":O" & rowResult).Value = sheet.Range("A" & j & ":O" & j).Value
sheet.Range("Q" & rowResult & ":Z" & rowResult).Value = sheet.Range("Q" & j & ":Z" & j).Value
rowResult = rowResult + 1
End If
Next j
Next i
End Sub
希望可以帮助到你，如果可以的话希望采纳哦~追问

运行的时候显示运行结果不匹配，需要试条

Answer 4

这个不用VBA，公式就能解决，在Q4中输入=IF(COUNTIF($A4:$O5,A4)>=2,A4,"")，右拉到AE5，然后下拉（因为A4:O4，共15列，所以需右拉到AE5）追问

数据多的时候怎么解决？

Answer 5

问题描述的不够清楚，建议放一张图来做个说明