多条件查询及姓名加序号标识唯一性
作者:admin 日期:2023-07-03
VLOOKUP及index+match组合
作者:admin 日期:2021-08-27
如何用VBA代码查询两列数据差异?
作者:admin 日期:2020-07-30
Sub CheckDataDiff()
Dim d As Object
Dim aData1, aData2, aRes, aKeys
Dim strKey As String, strMsg As String
Dim i As Long, k As Long
Dim intSame As Long, intShtA As Long, intShtB As Long
Set d = CreateObject("scripting.dictionary") '后期绑定字典
With Worksheets("表1") '表1 A列数据存入数组
aData1 = .Range("a1:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
With Worksheets("表2") '表2 A列数据存入数组
aData2 = .Range("a1:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
End With
For i = 2 To UBound(aData1) '遍历表1数据存入字典
strKey = aData1(i, 1)
d(strKey) = "表1" '将来源作为item
Next
ReDim aRes(1 To UBound(aData1) + UBound(aData2), 1 To 3) '定义结果数组大小
For i = 2 To UBound(aData2) '遍历表2数据
strKey = aData2(i, 1)
If d.exists(strKey) Then '如果存在关键字……
If d(strKey) = "表1" Then '如果该关键字属于表1,这层判断是为了避免表2存在重复值
intSame = intSame + 1 '累加相同个数
aRes(intSame, 1) = strKey '存入结果数组第1列
d(strKey) = "相同" '将关键字对应的item修改为相同
End If
Else '如果字典不存在该关键字,说明是表2独有
intShtB = intShtB + 1 '累加B表独有个数
aRes(intShtB, 3) = strKey '存入结果数组第3列
d(strKey) = "表2" '存入字典,item为来源表2
End If
Next
aKeys = d.keys '字典的keys集合
For i = 0 To UBound(aKeys) '遍历字典剔除tiem相同的即为A表独有值
strKey = aKeys(i)
If d(strKey) = "表1" Then
intShtA = intShtA + 1 '累加A表独有个数
aRes(intShtA, 2) = strKey '存入结果数组第2列
End If
Next
If k < intSame Then k = intSame
If k < intShtA Then k = intShtA
If k < intShtB Then k = intShtB
Worksheets("结果").Select
Range("a:e").ClearContents
Range("a1").Resize(UBound(aData1), 1) = aData1 'A列放表1数据
Range("b1").Resize(UBound(aData2), 1) = aData2 'B列放表2数据
Range("a1:e1") = Array("A表数据", "B表数据", "相同项", "A表独有", "B表独有")
Range("c2").Resize(k, UBound(aRes, 2)) = aRes '结果数组数据
strMsg = "两表相同项:" & intSame & vbCrLf _
& "A表独有项:" & intShtA & vbCrLf _
& "B表独有项:" & intShtB
MsgBox strMsg, , "公众号Excel星球"
Set d = Nothing
End Sub
代码解析▼
第8行至第10行代码将表1 A列的数据存入数组aData1。
第11行至第13行代码将表2 A列的数据存入数组aData2。
第14行至第17行代码遍历aData1的数据,作为关键字存入字典,并将对应的item设置为来源表的名字"表1"。
第18行代码声明一个结果数组aRes。结果数组的行数原本是未知的,但最大行不会超过两个数据源行数的合计值;列数是已知的,有3列,第1列存放两表相同项,第2列存放A表独有项,第3列存放B表独有项。
第19至第32行代码遍历数组aData2。
第20行代码将aData2的数据赋值字符串变量strKey。
第21行代码判断字典中是否存在strKey。
如果存在,同时对应的item为表1,则说明该值属于两表相同项,存入结果数组第1列。
如果不存在,说明该值B表独有,则存入结果数组第3列,即B表独有项;同时将该值存入字典,item设置为"表2",避免表2存在重复值时,结果数组出现项目重复统计问题。
第33行至第40代码遍历字典的Key,如果Key对应的Item为"表1",则说明是表1独有项,存入结果数组第2列。
第41行至第43行代码通过比较运算,获取结果数组有效行的最大行数,赋值变量k。
第49行代码将结果数组的数据写入工作表单元格区域。
第50行和第51行代码弹窗告知用户相同项、两表独有项的数目。
使用ADO和SQL在Excel工作表中执行查询操作的代码
作者:admin 日期:2020-02-23
Sub ReadFromWorksheetADO()
Dim wksData As Worksheet
Dim wksResult As Worksheet
Set wksData =ThisWorkbook.Worksheets("Sheet2")
Set wksResult =ThisWorkbook.Worksheets("Sheet3")
'清除已存在的数据
wksResult.Cells.ClearContents
Dim conn As New ADODB.Connection
conn.Open"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" &ThisWorkbook.FullName & ";" & _
"ExtendedProperties=""Excel 12.0;HDR=Yes;"";"
'在字符串中存储查询语句
Dim query As String
query = "Select * from [" &wksData.Name _
& "$] Where 物品='苹果' "
'运行查询并存储在记录集中
Dim rs As New Recordset
rs.Open query, conn
'输入标题
Dim i As Long
For i = 0 To rs.Fields.Count - 1
wksResult.Cells(1, i + 1).Value2 =rs.Fields(i).Name
Next i
'输入数据
wksResult.Range("A2").CopyFromRecordset rs
'关闭连接
conn.Close
End Sub
代码中,打开并连接数据库的语句为:
conn.Open"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" &ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel12.0;HDR=Yes;"";"
适用于2007及以上版本。在同一代码中,只需要连接数据库一次,接着可以执行多个查询操作,无需每次查询前都进行连接。
SQL查询语句为:
query = "Select * from [" & wksData.Name _
& "$] Where 物品='苹果' "
在工作表wksData中查询物品为“苹果”的记录,*号表示获取记录的所有字段。
我们还可以设置其他条件查询,获得相应的记录。例如:
1.查询物品为“苹果”且数量大于等于100的记录。
query = "Select * from [" & wksData.Name _
& "$] Where 物品='苹果' and 数量>=100"
2. 查询物品为“苹果”或者数量大于等于100的记录。
query = "Select * from [" & wksData.Name _
& "$] Where 物品='苹果' or 数量>=100"
3.查询编号以12开头的记录。
query = "Select * from [" & wksData.Name _
& "$] Where 编号 like '12%' "
4.查询编号以1结尾的记录。
query = "Select * from [" & wksData.Name _
& "$] Where 编号 like '%1' "
5.查询编号中包含200的记录。
query = "Select * from [" & wksData.Name _
& "$] Where 编号 like '%200%' "
也可以选择获取满足条件的记录中的字段。例如,查找并获取物品为“苹果”的记录中的编号、物品和单价:
query = "Select 编号,物品,单价 from [" & wksData.Name _
& "$] Where 物品='苹果' "
来源:
https://cloud.tencent.com/developer/article/1467282
在excel中引用ADO类库的两种方法
作者:admin 日期:2020-02-23
在VBA中引用ADO类库一般有两种方式。
一种是前期绑定。
所谓前期绑定,是指在VBE中手工勾选引用Microsoft ADO相关类库。
在Excel中,按<Alt+F11>快捷键打开VBA编辑窗口,依次单击【工具】→【引用】,打开【引用-VBAProject】对话框。在【可使用的引用】列表框中,勾选“Microsoft ActiveX Data Objects 2.8 Library”库,或“Microsoft ActiveX Data Objects 6.1 Library”库,单击【确定】按钮关闭对话框。
另一种是使用代码后期绑定。
Sub 后期绑定()
Dim cnn As Object
Set cnn = CreateObject("adodb.connection")
End Sub
两种方式的主要区别是,前期绑定后,在代码编辑过程中,VBE的“自动列出成员”功能,可以提供ADO的属性和方法,这便于代码快捷、准确的编写,但当他人的Excel工作簿并没有手工前期绑定ADO类库时,相关代码将无法运行;因此后期代码绑定ADO的通用性会更强些,它不需要手工绑定相关类库。
来源:https://mp.weixin.qq.com/s?__biz=MzI0MTAxNTc5NA==&mid=2468634477&idx=3&sn=47e652209bab466e8bab3e27cd38a58d&chksm=ffc2f1f0c8b578e6e7ea0fac79289ff858e82641dd740e45e3135644a895fd74a550061bdf99&scene=21#wechat_redirect
各版本ExcelAdo连接代码
作者:admin 日期:2020-02-23
07~19版本ExcelAdo连接代码:
Sub test()
Dim cnn As Object
Set cnn = CreateObject("adodb.connection")
cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.FullName
If cnn.State = 1 Then
MsgBox "连接成功!" & vbCrLf & "ADO版本为:" & cnn.Version & vbCrLf & "Connection对象提供者名称:" & cnn.provider
cnn.Close
Set cnn = Nothing
Else
MsgBox "数据库连接失败"
End If
End Sub
来源:https://mp.weixin.qq.com/s?__biz=MzI0MTAxNTc5NA==&mid=2468634602&idx=4&sn=4a53cea4ba4a85ae828b17a8f42f693e&chksm=ffc2f177c8b578618aee2e7408bac59c76470c9211969933e3617f91e5e79373d469eebf7927&scene=21#wechat_redirect以下代码兼顾了03及各高级版本Excel的情况:Sub Mycnn3()Dim cnn As ObjectDim strPath As StringDim str_cnn As StringSet cnn = CreateObject("adodb.connection")strPath = ThisWorkbook.FullNameIf Application.Version < 12 Thenstr_cnn = "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & strPathElsestr_cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & strPathEnd Ifcnn.Open str_cnncnn.CloseSet cnn = NothingEnd sub来源:https://mp.weixin.qq.com/s?__biz=MzI0MTAxNTc5NA==&mid=2468634477&idx=3&sn=47e652209bab466e8bab3e27cd38a58d&chksm=ffc2f1f0c8b578e6e7ea0fac79289ff858e82641dd740e45e3135644a895fd74a550061bdf99&scene=21#wechat_redirect
学SQL in Excel教程合集
作者:admin 日期:2020-02-23
扫码领红包!领到大红包的小伙伴赶紧使用哦!