不同行和列，重复的数据（数字）如何找出来并且汇总？

anzhao

小门店，用excel做的一个每天的营业额流水账。见附件： 重复数据.zip (95.45 KB, 下载次数: 7)

2020-12-19 18:49 上传

点击文件名下载附件

问题：怕数据输入重复，造成结余不准确，如何检查重复的数据，并且能提取重复数据？

如图：黄色和红色是自己手工填充的。

anzhao

大佬在哪里？

tiger1976

Sub lll()

Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer, h As Integer, g As Integer
Dim sht As Worksheet
Dim arr
Dim dic As New Dictionary

Set sht = Worksheets("sheet1")
i = sht.Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("g4:k" & i)

For j = 1 To UBound(arr)
    For k = 1 To 5
        If arr(j, k) <> "" Then
            dic.Item(arr(j, k)) = ""
        End If
        
    Next
Next

For m = 0 To dic.Count - 1
    If Application.WorksheetFunction.CountIf(Range("g4:k" & i), dic.Keys(m)) > 1 Then
        n = n + 2
        For h = 4 To i
            For g = 7 To 11
                If Cells(h, g).Value = dic.Keys(m) Then
                    Cells(h, g).Interior.ColorIndex = n
                End If
            Next
        Next
    End If
Next


End Sub

tiger1976

Sub lll()

Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer, h As Integer, g As Integer
Dim sht As Worksheet
Dim arr
Dim dic As New Dictionary

Set sht = Worksheets("sheet1")
i = sht.Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("g4:k" & i)

For j = 1 To UBound(arr)
    For k = 1 To 5
        If arr(j, k) <> "" Then
            dic.Item(arr(j, k)) = ""
        End If

    Next
Next

For m = 0 To dic.Count - 1
    If Application.WorksheetFunction.CountIf(Range("g4:k" & i), dic.Keys(m)) > 1 Then
        n = n + 2
        For h = 4 To i
            For g = 7 To 11
                If Cells(h, g).Value = dic.Keys(m) And Application.WorksheetFunction.CountIf(Range(Cells(4, g), Cells(i, g)), Cells(h, g)) = 1 Then
                    Cells(h, g).Interior.ColorIndex = n
                End If
            Next
        Next
    End If
Next


End Sub

anzhao

tiger1976 发表于 2021-1-17 22:28
Sub lll()

Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer, h As Integer, ...

老铁这个肿么用？