麻烦大师修改一下查找工作表数据的路径，谢谢！

iwangyi

楼主只是取值用索引 GETOBJECT (PATH&”\“&文件名）

无忧鸟

iwangyi 发表于 2020-1-2 17:14
楼主只是取值用索引 GETOBJECT (PATH&”\“&文件名）

其它问题都基本解决了，就是不知道为什么提取出来的时间是乱码的

liulang0808

无忧鸟 发表于 2020-1-2 17:07
发现个问题，就是提取出来的时间是乱码的不知道是怎么回事？

把日期那一列格式先设置好，或者运行后再设置看看

无忧鸟

liulang0808 发表于 2020-1-2 18:25
把日期那一列格式先设置好，或者运行后再设置看看

每次把日期设置好后再按查找提取出来的时间又恢复成乱码了，这个我搞了一个下午都找不到原因

liulang0808

无忧鸟 发表于 2020-1-2 18:38
每次把日期设置好后再按查找提取出来的时间又恢复成乱码了，这个我搞了一个下午都找不到原因

那么在代码里增加对该列的日期格式设置
自己可以录制宏，添加进去

无忧鸟

liulang0808 发表于 2020-1-2 18:40
那么在代码里增加对该列的日期格式设置
自己可以录制宏，添加进去

试了很多代码都不行，只要一提取时间就变乱码，但以前用的相同工作薄下的提取代码就不会出现这种时间变乱码的情况，以下是我以前在相同工作薄提取数据的代码，麻烦再看看：

Sub CommandButton1_Click1()
Application.ScreenUpdating = False
Dim ran As Range
For Each ran In ActiveSheet.UsedRange
If [b3] = "" Then ran.Value = "请输入查找内容"
Next
Application.ScreenUpdating = True

Dim arr, d, i&, j%
Set d = CreateObject("scripting.dictionary")
Sheet17.Activate
[a6:as2000].Clear
tj = [b3]
arr = Sheet3.UsedRange
For i = 1 To UBound(arr)
    For j = 1 To UBound(arr, 2)
        If arr(i, j) Like "*" & tj & "*" Then
            If Not d.Exists(i) Then d(i) = "": Exit For
        End If
        Next
Next
If d.Count > 0 Then
    For Each a In d.keys
        n = n + 1
        Sheet3.Cells(a, 1).Resize(1, UBound(arr, 2)).Copy Cells(n + 5, 1)
    Next   
End If
End Sub
－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－
下面这个是您写给我的：
Sub dsmch()

Set d = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Sheet2.Activate
[a6:an30000].Clear
tj = [b2]
With Workbooks.Open("F:\资料\资料.xlsx")
arr = .Sheets(1).UsedRange
.Close False
End With
r = 0
For i = 1 To UBound(arr)
    For j = 1 To UBound(arr, 2)
        If arr(i, j) Like "*" & tj & "*" Then
            If Not d.Exists(i) Then
                d(i) = ""
                r = r + 1
                For X = 1 To UBound(arr, 2)
                    arr(r, X) = arr(i, X)
                Next X
            End If
        End If
    Next
Next
If d.Count > 0 Then
    Sheet2.Cells(3, 1).Resize(r, UBound(arr, 2)) = arr
End If
Application.ScreenUpdating = True
End Sub