可以实现有条件的去除重复值吗？

rocklyman

需要按机台、人员分开统计批退率，卡在需要有条件去重这一步上了，求大神指点
新建Microsoft Excel 工作表 (3).zip (585.48 KB, 下载次数: 16)

2023-3-27 10:34 上传

点击文件名下载附件

LIUZHU

需要将“受入批次”、“退批次”、“批退率”的统计规则说明清楚。

sdytsxd991122

半百

ykcbf1100

附件请参考。。。

gwjkkkkk

Sub test()
    Dim ar(0 To 1), br, cr, i&, j&, n As Byte, dic As Object, vKey, regEx As Object
   
    Set dic = CreateObject("Scripting.Dictionary")
    Set regEx = CreateObject("VBScript.RegExp")
    br = [A1].CurrentRegion
   
    For i = 0 To 1
       dic.RemoveAll: r = 2
       With Cells(3, i * 5 + 49).CurrentRegion
           .Offset(2).Clear
           ar(i) = .Resize(UBound(br) + 1)
           If i = 0 Then
               regEx.Pattern = "[\u4e00-\u9fa5]+|\/"
           Else
               regEx.Pattern = "[\u4e00-\u9fa5]+"
           End If
           For j = 2 To UBound(br)
               If regEx.test(br(j, 47)) = CBool(i) Then
                    n = IIf(br(j, 8) = "退", 1, 0)
                    vKey = Trim(br(j, 2))
                    If Not dic.exists(vKey) Then
                        dic(vKey) = Array(1, n)
                    Else
                        cr = dic(vKey)
                        cr(0) = cr(0) + 1
                        cr(1) = cr(1) + n
                        dic(vKey) = cr
                    End If
               End If
           Next j
           For Each vKey In dic.keys
               r = r + 1
               ar(i)(r, 1) = vKey
               ar(i)(r, 2) = dic(vKey)(0)
               ar(i)(r, 3) = dic(vKey)(1)
               ar(i)(r, 4) = ar(i)(r, 3) / ar(i)(r, 2)
           Next
       End With
       With Cells(3, i * 5 + 49).Resize(r, UBound(ar(i), 2))
           .Value = ar(i)
            .HorizontalAlignment = xlCenter
            .Borders.LineStyle = xlContinuous
            .EntireRow.AutoFit
       End With
    Next i
   
    Beep
End Sub

gwjkkkkk

参与一下。。。