|
|
Sub limonet()
Dim Cn As Object, StrSQL$, Rs As Object, Arr As Variant, Brr As Variant, i%, S$
Columns("A:e").ClearContents
Set Cn = CreateObject("adodb.connection")
Cn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
StrSQL = "select month(开票日期) as 月,购货方名称,购货方社会统一信用代码 from [发票数据$A:N] group by month(开票日期),购货方名称,购货方社会统一信用代码"
StrSQL = "select 购货方社会统一信用代码 from (" & StrSQL & ") group by 购货方社会统一信用代码 having count(*)>=3"
Arr = Cn.Execute(StrSQL).getrows
For i = 0 To UBound(Arr, 2)
StrSQL = "select top 2 year(开票日期)&'-'&month(开票日期) from [发票数据$A:N] where 购货方社会统一信用代码='" & Arr(0, i) & "' group by year(开票日期)&'-'&month(开票日期) order by year(开票日期)&'-'&month(开票日期) desc"
Brr = Cn.Execute(StrSQL).getrows
If DateDiff("M", Brr(0, 1), Date) > 12 Then S = S & "'" & Arr(0, i) & "',"
Next i
StrSQL = "select '流失客户' as 分类,购货方名称,购货方社会统一信用代码 from [发票数据$A:N] where 购货方社会统一信用代码 in(" & Left(S, Len(S) - 1) & ") group by 购货方名称,购货方社会统一信用代码"
Set Rs = Cn.Execute(StrSQL)
For i = 0 To Rs.Fields.Count - 1
Sheet3.Cells(1, i + 1) = Rs.Fields(i).Name
Next i
Sheet3.Range("A2").CopyFromRecordset Rs
Rs.Close
Cn.Close
Set Rs = Nothing
Set Cn = Nothing
End Sub
|
|
楼主: tte3
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2022-12-19 14:37
楼主
)
