当前位置：首页 → 问答吧 → 用VBA提取数据，先谢谢了！！

用VBA提取数据，先谢谢了！！

时间：2011-08-08

来源：互联网

附件中B列数据提取到K列中，若有重复行，只提取一次，谢谢了

提取数据.rar (7.42 KB)

[ 本帖最后由 song22602 于 2011-8-8 10:42 编辑 ]

附件

提取重复-不重复.rar(2.87 KB)

2011-8-8 10:41, 下载次数: 15

作者: song22602 发布时间: 2011-08-08

你用数据透视表试试

作者: qq89486841 发布时间: 2011-08-08

引用:

原帖由 song22602 于 2011-8-8 10:41 发表
附件中B列数据提取到K列中，若有重复行，只提取一次，谢谢了970339

复制内容到剪贴板

代码:

Sub Slt() '不重复值
Dim dic As Object
Dim arr, k%

Set dic = CreateObject("Scripting.Dictionary")
arr = Range("A1", [A65536].End(3))
For k = 1 To UBound(arr)
dic(arr(k, 1)) = ""
Next

arr = dic.keys
[k1].Resize(dic.Count) = Application.Transpose(arr)
dic.RemoveAll
Erase arr
End Sub

放在K 列

作者: wj2368 发布时间: 2011-08-08

复制内容到剪贴板

代码:

Dim arr, d As Object, i&
Set d = CreateObject("scripting.dictionary")
arr = Range("b4:b" & Range("a65536").End(xlUp).Row)
For i = 1 To UBound(arr)
d(arr(i, 1)) = ""
Next i
Range("k4").Resize(d.Count, 1) = Application.Transpose(d.keys)

作者: dsmch 发布时间: 2011-08-08

复制内容到剪贴板

代码:

Sub aa()
Dim Cn As Object, msql1$, shname$, load$
wbname = "/" & ActiveWorkbook.Name
Set Cn = CreateObject("Adodb.Connection")
Cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & ThisWorkbook.Path & wbname
'******************************************
shname = "Sheet1"
load = "[" & shname & "$A3:B65535]"
msql1 = "Select 姓名,序号 From " & load & " Where 序号 not like '' group by 序号,姓名"
With Sheets(shname)
[A3].Resize(1, 2) = Array("序号", "姓名")
.[K4].CopyFromRecordset Cn.Execute(msql1)
End With
Cn.Close: Set Cn = Nothing
End Sub

作者: loman77 发布时间: 2011-08-08

老师,谢谢你的指导.

作者: song22602 发布时间: 2011-08-08

老师,谢谢你的指导.

作者: song22602 发布时间: 2011-08-08

不错，很好用啊。学习了

作者: abc0931 发布时间: 2011-08-08

提取数据.rar (17.39 KB)
再加一个日期条件，谢谢了