EXCEL(VBA)~SQL 经典写法范本汇集(三)
时 间:2012-04-09 08:58:12
作 者:欢乐小爪 ID:20149 城市:杭州
摘 要:EXCEL(VBA)~SQL 经典写法范本汇集(三)
正 文:
回答 27019170网友的问题
1.提取本文件夹内除本工作簿以外的工作簿的一个人的姓名,货号,序号等
请输入姓名 | 何芝全 | ||||||
姓名 | 货号 | 序号 | 流程名称 | 单价 | 数量 | 金额 | 组别 |
何芝全 | 852152 | 21 | 上鞋舌 | 50 | 0 | A组 | |
何芝全 | 852361 | 12 | 车大面假线(2) | 180 | 0 | A组 | |
何芝全 | 852361 | 21 | 压扣 | 0.01 | 755 | 7.55 | A组 |
何芝全 | 852361 | 32 | 车网脚及修建 | 0.02 | 740 | 14.8 | A组 |
何芝全 | 852152 | 21 | 上鞋舌 | 50 | 0 | B组 | |
何芝全 | 852361 | 12 | 车大面假线(2) | 180 | 0 | B组 | |
何芝全 | 852361 | 21 | 压扣 | 0.01 | 755 | 7.55 | B组 |
何芝全 | 852361 | 32 | 车网脚及修建 | 0.02 | 740 | 14.8 | B组 |
何芝全 | 852152 | 21 | 上鞋舌 | 50 | 0 | C组 | |
何芝全 | 852361 | 12 | 车大面假线(2) | 180 | 0 | C组 |
代码如下:
Sub 提取工资()
Dim adoConn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim FilePath As String
Dim sql As String
Dim FileName As String
Dim MaxRow As Long
On Error GoTo 10000
Sheets("按扭界面").Select
MaxRow = Range("a65536").End(xlUp).Row
Range("a6:h" & MaxRow + 1).ClearContents
FilePath = ThisWorkbook.Path
FileName = Dir(FilePath & "\*.xls")
Do While FileName <> "" And FileName <> ThisWorkbook.Name
Set adoConn = New ADODB.Connection
adoConn.Open "Provider=Microsoft.Jet.OleDb.4.0;Extended Properties=Excel 8.0;Data Source=" & FilePath & "\" & FileName
sql = "select 姓名,货号,序号,流程名称,单价,数量,金额,'" & Mid(FileName, 1, InStr(1, FileName, ".") - 1) & "' as 组别 " & _
" from [计算结果$] " & _
" where 姓名= '" & [b1] & "'" ' " where 姓名='" & EmployeeName & "'"
Set rs = New ADODB.Recordset
rs.Open sql, adoConn, adOpenKeyset, adLockOptimistic
Range("a" & MaxRow + 1).CopyFromRecordset rs
MaxRow = MaxRow + rs.RecordCount + 1
FileName = Dir
Loop
Set rs = Nothing
Set adoConn = Nothing
Range("a6:h" & MaxRow).HorizontalAlignment = xlCenter
Exit Sub
10000: MsgBox Error()
End Sub
2.查询本文件夹内除本工作簿以外的工作簿的姓名重名情况
先不重复---》后重复
关于不重复用sql ;重复用循环
Sub 查询重复姓名()
Dim adoConn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim FilePath As String
Dim sql As String
Dim FileName As String
Dim I&
Dim MaxRow As Long
On Error GoTo 10000
Sheets("查验重姓名").Select
MaxRow = Range("a65536").End(xlUp).Row + 1
Range("a2:b" & MaxRow).ClearContents
FilePath = ThisWorkbook.Path
FileName = Dir(FilePath & "\*.xls")
Do While FileName <> "" And FileName <> ThisWorkbook.Name
Set adoConn = New ADODB.Connection
adoConn.Open "Provider=Microsoft.Jet.OleDb.4.0;Extended Properties=Excel 8.0;Data Source=" & FilePath & "\" & FileName
sql = "select distinct 姓名,'" & Mid(FileName, 1, InStr(1, FileName, ".") - 1) & "' as 组别 " & _
"from [计算结果$] where 姓名 is not null"
Set rs = New ADODB.Recordset
rs.Open sql, adoConn, adOpenKeyset, adLockOptimistic
Range("a" & MaxRow).CopyFromRecordset rs
MaxRow = MaxRow + rs.RecordCount
FileName = Dir
Loop
Set rs = Nothing
Set adoConn = Nothing
Range("A2:B" & MaxRow).Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False
MaxRow = Range("a65536").End(xlUp).Row
For I = MaxRow To 2 Step -1
If Cells(I, 1) = Cells(I - 1, 1) Then
Cells(I - 1, 2) = Cells(I - 1, 2) & "/" & Cells(I, 2)
Rows(I).EntireRow.Delete
ElseIf Len(Cells(I, 2)) < 5 Then
Rows(I).EntireRow.Delete
End If
Next
MsgBox "完成", 1 + 64, "i love you"
Exit Sub
10000: MsgBox Error()
End Sub
Sub 清空()
Sheets("按扭界面").Range("a6:h65536").ClearContents
End Sub
Access软件网官方交流QQ群 (群号:54525238) Access源码网店
常见问答:
技术分类:
源码示例
- 【源码QQ群号19834647...(12.17)
- 【Access选项卡示例】Ac...(09.09)
- 【Access源码示例】按输入...(09.02)
- 【Access日期区间段查询】...(08.29)
- 【Access日期区间段查询】...(08.27)
- Access怎样才能实现日期时...(08.21)
- 【Access定时打开查询】A...(08.19)
- Access生成固定数量的记录...(08.13)
- Access怎样才能实现日期时...(08.12)
- Access利用导航窗体控件对...(08.03)
学习心得
最新文章
- Access表中的字段名、字段标题...(09.19)
- Access快速开发平台--更改“...(09.18)
- 【中秋及国庆优惠】Access培训...(09.15)
- Access如何将日期型的数值转换...(09.14)
- 英文输入法输入数据中存在单引号引起...(09.11)
- 【Access选项卡示例】Acce...(09.09)
- 让Access光标停留在指定的控件...(09.07)
- 关于Access查询条件里使用通配...(09.06)
- Access报表偷懒制作法--Ac...(09.05)
- Access快速开发平台--窗体数...(09.04)