多个月份多数据取单月份数据

5550381

按要求取整年，或者单月份的数据用VBA怎么实现，之后再进行数据差异的对比

ykcbf1100

提取二次数据，再比较一次，比较费时，先标记一下吧。

Qs18

Sub 提取数据2月数据() '提取数据
Sheet6.Range("a5:l10000").ClearContents

Dim arr, dic As Object, i, j
arr = Sheet3.Range("a1").CurrentRegion
Set dic = CreateObject("scripting.dictionary")
For j = 3 To 7 Step 4
yf = Sheet6.Cells(2, j)
ReDim brr(1 To UBound(arr), 1 To 3)

dic.RemoveAll
m = 0
    For i = 3 To UBound(arr)
        If VBA.Month(CDate(arr(i, 2))) & "月份" = yf Then
            s = arr(i, 1)
            If Not dic.exists(s) Then
                m = m + 1
                brr(m, 1) = s
                brr(m, 2) = 1
                brr(m, 3) = arr(i, 8)
                dic(s) = m
            Else
                r = dic(s)
                brr(r, 2) = brr(r, 2) + 1
                brr(r, 3) = brr(r, 3) + arr(i, 8)
            End If
        End If
    Next
  Sheet6.Cells(5, j - 1).Resize(m, 3) = brr
Next
End Sub
Sub 新增客户()
arr = Sheet6.Range("b5:b" & Sheet6.Cells(Rows.Count, "b").End(xlUp).Row)
brr = Sheet6.Range("f5:f" & Sheet6.Cells(Rows.Count, "f").End(xlUp).Row)
ReDim crr(1 To (UBound(arr) + UBound(brr)), 1 To 1)
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    dic(arr(i, 1)) = 1
Next
For j = 1 To UBound(brr)
    If dic(brr(j, 1)) <> 1 Then
        m = m + 1
        crr(m, 1) = brr(j, 1)
    End If
Next
Sheet6.Range("j5").Resize(m, 1) = crr
Call 流失客户
End Sub
Sub 流失客户()
brr = Sheet6.Range("b5:b" & Sheet6.Cells(Rows.Count, "b").End(xlUp).Row)
arr = Sheet6.Range("f5:f" & Sheet6.Cells(Rows.Count, "f").End(xlUp).Row)
ReDim crr(1 To (UBound(arr) + UBound(brr)), 1 To 1)
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    dic(arr(i, 1)) = 1
Next
For j = 1 To UBound(brr)
    If dic(brr(j, 1)) <> 1 Then
        m = m + 1
        crr(m, 1) = brr(j, 1)
    End If
Next
Sheet6.Range("l5").Resize(m, 1) = crr
End Sub

Qs18

试一下。。。

Qs18

测试一下。。。

tanglf188

只做了数据提取，比对方法不是太清除。没法做，请参考

5550381

Qs18 发表于 2024-5-29 14:24
测试一下。。。

在对比的时候会出现重复值，两边都会出现该名字。这个要需要怎么解决

Qs18

5550381 发表于 2024-5-29 15:27
在对比的时候会出现重复值，两边都会出现该名字。这个要需要怎么解决

我这边没有看到相同的数据，您截图看一下

grf1973

重写了所有提取、分析代码。请测试。

LIUZHU

完成了，不知道结果对不对，没验证