怎样用VBA导入数据，判断重复并给重复数据标色

fgq5910

需求：
怎样用VBA导入数据，判断重复并给重复数据标色
首先清空教师核对表，再导入教学任务表数据
1、导入数据
如：把教学任务表中F3的姓名导入教师核对表的C3中
2、判断行数据是否重复
（1）用VBA判断行重复
（2）用VBA把重复姓名标色
教师核对表中：
合并单元格的姓名与同列其他单元格有相同的，算重复
如：C3中邓建安与D3中的张梓民、邓建安，有两个邓建安，此行算重复
A5-V5、A7-V7两行数据重复，
谢谢！

sunya_0529

chxw68

参与一下。

ykcbf1100

参与一下。。。

cidanji

用VBA导入数据，判断重复并给重复数据标色.rar (37.84 KB, 下载次数: 8)

2023-12-5 09:10 上传

点击文件名下载附件

gwjkkkkk

参与一下。。。

cyq4896

参与一下..

usedrange

Sub t()
    Dim arr, brr, crr, drr, d$, sht, r%, c%, ro%, i%, j%, h%, rr%, m%, wd, mst$

    ro = Sheets("教学任务表").Range("h1048576").End(xlUp).Row
    arr = Sheets("教学任务表").Range("a3:h" & ro)
    ReDim brr(1 To 21, 1 To 21)
    With Sheets("教师核对表")
        rr = .Range("a1048576").End(xlUp).Row
        crr = .Range("c2:v2")
        drr = .Range("a3:a" & rr)
        .Range("c3:w23").Clear
        For i = 1 To UBound(arr)
            If arr(i, 3) <> "" Then d = arr(i, 3)
            For j = 1 To UBound(crr, 2)
                If d = crr(1, j) Then c = j
            Next j
            For h = 1 To UBound(drr)
                If drr(h, 1) = arr(i, 8) Then r = h
            Next h
            brr(r, c) = arr(i, 6)
        Next i
        .Range("c3").Resize(UBound(brr), UBound(brr, 2)) = brr
        '核对重复数据
        r = 0
        Set sht = .Range("c3:w" & rr)
        For Each v In sht
            If v <> "" Then
                r = v.Row - 2
                m = 0
                mst = ""
                For i = 1 To UBound(brr, 2)
                    If brr(r, i) <> "" Then mst = mst & brr(r, i) & "、"
                Next i
                wd = Split(mst, "、")
                For j = 0 To UBound(wd) - 1
                    If InStr(v, wd(j)) Then
                        m = m + 1
                        If m > 1 Then
                            Cells(v.Row, v.Column).Interior.ColorIndex = 6
                            Cells(v.Row, 23).Value = "重复"
                        End If
                    End If
                Next j
            End If
        Next v
    End With
End Sub