麻烦高手们帮忙完成一个关于跨表重复值去除后多条件统计，谢谢！

蓝轩雨

麻烦高手们帮忙完成一个关于跨表重复值去除后多条件统计，谢谢！
上传了两个附件，附件一不具备文本格式的数据统计，而附件二B列是具备有文本格式数据统计的，麻烦各位帮忙一下

hdbk

先解决第一问题：


Sub DoCona()
Sheets("sheet1").Range("a1").CurrentRegion.Clear
Dim con As Object, s%, i&
Set con = CreateObject("adodb.connection")
con.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
For Each sht In Worksheets
      If sht.Name <> "Sheet1" Then
      Sql = "select *from [" & sht.Name & "$]"
For i = 0 To con.Execute(Sql).fields.Count - 1
      Cells(1, i + 1) = con.Execute(Sql).fields(i).Name
Next
r = Sheets("sheet1").Range("a1048576").End(xlUp).Row + 1
Sheets("sheet1").Range("a" & r).CopyFromRecordset con.Execute(Sql)
End If
Next
Sql1 = "select count(姓名) from (select distinct 姓名 from [Sheet1$] where F1<>'工程部' and 完成情况<>'已完成')"
rs = con.Execute(Sql1)
Sheets("sheet1").Range("f1").CopyFromRecordset con.Execute(Sql1)
Sheets("sheet1").Range("e1") = "符合条件的人数为:"
Sheets("sheet1").Range("a1").CurrentRegion.Clear
con.Execute(Sql).Close
con.Close: Set con = Nothing
MsgBox "统计完毕"
End Sub

abc123281

很少见过这种统计要求的

蓝桥玄霜

请见代码。

蓝轩雨

发到代码这边来了。。。本想用函数统计的，不好意思哈