當前位置:成語大全網 - 新華字典 - Excel寫個VBA誰會?

Excel寫個VBA誰會?

以下是實現該功能的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行輸出。