ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 2313|回复: 17

[已解决] 批量查找数组所在位置附件

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-6-3 10:09 | 显示全部楼层 |阅读模式
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
本帖最后由 谢玉红 于 2019-6-3 19:19 编辑

附件 批量查找数组所在位置附件.rar (447.77 KB, 下载次数: 15)
谢谢老师!
之前有个单个查询的,数据量太大,需要批量查询。求帮忙。谢谢了。

TA的精华主题

TA的得分主题

发表于 2019-6-3 11:40 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-6-3 12:52 | 显示全部楼层
用PowerQuery做了一个,不知道文件多了,会不会受影响
两个要求:
1,目标文件不要和源文件放在同一目录
2,请编辑代码第二步的路径位置,把“你的源文件路径”更改为真实数据路径。

批量查找数组所在位置附件.rar

452.82 KB, 下载次数: 7

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-6-3 12:53 | 显示全部楼层
不知道为什么 发表于 2019-6-3 11:40
动图效果,满意评分!

第一列,显示数据来源的工作簿名称,貌似代码没有解决

TA的精华主题

TA的得分主题

发表于 2019-6-3 14:02 | 显示全部楼层
wdx223 发表于 2019-6-3 12:53
第一列,显示数据来源的工作簿名称,貌似代码没有解决

看楼主的需求,A-E列数据是楼主填写的把。根据有的数据找到对应的位置。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-3 15:58 来自手机 | 显示全部楼层
不知道为什么 发表于 2019-6-3 14:02
看楼主的需求,A-E列数据是楼主填写的把。根据有的数据找到对应的位置。

A列数据与CDE列数据都是事先填上去的。

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-3 16:23 来自手机 | 显示全部楼层
不知道为什么 发表于 2019-6-3 11:40
动图效果,满意评分!

老师你好,麻烦贴上你的代码试试看。

TA的精华主题

TA的得分主题

发表于 2019-6-3 17:14 | 显示全部楼层
Option Explicit
Sub test()
Dim d As Object, cnn As Object, rst As Object, fil, sql$, ar
Dim i&, j&, k&, n&, s$, t$, st$, x&, y&
Application.ScreenUpdating = False
Sheet1.Activate
[g1].Resize(789, 123).ClearContents
ar = [a1].CurrentRegion.Resize(, 5)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(ar)
    s = ""
    For j = 1 To UBound(ar, 2)
        s = s & "," & ar(i, j)
    Next
    d(Mid(s, 2)) = Array(i, 7)
Next
Set cnn = CreateObject("Adodb.Connection")
Set rst = CreateObject("Adodb.Recordset")
For Each fil In CreateObject("Scripting.FilesyStemObject").GetFolder(ThisWorkbook.Path).Files
    If fil.Name <> ThisWorkbook.Name And InStr(fil.Name, "~$") = 0 Then
        t = Split(fil.Name, ".")(0) & ","
        n = n + 1
        If n = 1 Then
            cnn.Open "provider=microsoft.ace.oledb.12.0;extended properties='Excel 12.0;hdr=no';data source=" & fil
        Else
            st = "[Excel 12.0;hdr=no;Database=" & fil & ";]."
        End If
        sql = "SELECT * FROM " & st & "[Sheet1$]"
        rst.Open sql, cnn, 1, 3
        ar = rst.GetRows
        For i = 0 To UBound(ar, 2) Step 5
            For j = 0 To UBound(ar)
                s = ""
                For k = i To i + 2
                    s = s & "," & ar(j, k)
                Next
                s = t & s
                If d.exists(s) Then
                    y = d(s)(0)
                    x = d(s)(1)
                    Cells(y, x) = Cells(i + 1, j + 1).Address(0, 0)
                    d(s) = Array(y, x + 1)
                End If
            Next
        Next
        If rst.State = 1 Then rst.Close
    End If
Next
cnn.Close
Set cnn = Nothing
Set rst = Nothing
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "ok!", 64
End Sub

批量查找数组所在位置附件.rar

458.06 KB, 下载次数: 13

评分

3

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-6-3 19:20 来自手机 | 显示全部楼层
xiangbaoan 发表于 2019-6-3 17:14
Option Explicit
Sub test()
Dim d As Object, cnn As Object, rst As Object, fil, sql$, ar

谢谢老师,试了一下很好用。程序好,人品更好!再谢!

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-6-3 19:29 | 显示全部楼层
谢玉红 发表于 2019-6-3 19:20
谢谢老师,试了一下很好用。程序好,人品更好!再谢!

谢谢夸奖……呵呵, 不必客气,这是一个学习交流的平台、助人的平台。祝进步,开心!
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 13:01 , Processed in 0.049330 second(s), 11 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表