完全匹配查找字符串

mmwwdd

ncow 发表于 2024-2-20 16:39
用instr函数查找，再加上判断两个字符串的长度一致，两个都符合时就一致

看看我的附件

ykcbf1100

mmwwdd 发表于 2024-2-20 16:20
上附件了，大神给看一下

你这个也不用去精确查找啊，用字典就行。

附件供参考。。。

ykcbf1100

参与一下，二个表都写了代码。

1. Sub ykcbf()  '//2024.2.20
   
2.     Dim arr, brr(1 To 10000, 1 To 100)
   
3.     Set Fso = CreateObject("scripting.filesystemobject")
   
4.     Application.ScreenUpdating = False
   
5.     Set sh = ThisWorkbook.Sheets("统计表2")
   
6.     p = ThisWorkbook.Path & ""
   
7.     For Each f In Fso.GetFolder(p).Files
   
8.         If f.Name Like "*.xls*" Then
   
9.             If InStr(f.Name, ThisWorkbook.Name) = 0 Then
   
10.                 fn = Fso.GetBaseName(f)
    
11.                 Set Wb = Workbooks.Open(f, 0)
    
12.                 With Wb.Sheets("汇总表")
    
13.                     r = .Cells(Rows.Count, 1).End(3).Row
    
14.                     arr = .Range("a1:t" & r)
    
15.                     Wb.Close False
    
16.                 End With
    
17.                 For i = 6 To UBound(arr)
    
18.                     m = m + 1
    
19.                     For j = 1 To UBound(arr, 2)
    
20.                         brr(m, j) = arr(i, j)
    
21.                     Next
    
22.                 Next
    
23.             End If
    
24.         End If
    
25.     Next f
    
26.     With sh
    
27.         .UsedRange.Offset(5).Clear
    
28.         With .[a6].Resize(m, UBound(arr, 2))
    
29.             .Value = brr
    
30.             .Borders.LineStyle = 1
    
31.             .HorizontalAlignment = xlCenter
    
32.             .VerticalAlignment = xlCenter
    
33.         End With
    
34.     End With
    
35.     Application.ScreenUpdating = True
    
36. End Sub
    
37. 
    
38. Sub 数据提取()  '//2024.2.20
    
39.     Dim arr, brr
    
40.     Set d = CreateObject("Scripting.Dictionary")
    
41.     Application.ScreenUpdating = False
    
42.     arr = ThisWorkbook.Sheets("统计表2").UsedRange
    
43.     For i = 6 To UBound(arr)
    
44.         s = arr(i, 1)
    
45.         d(s) = i
    
46.     Next
    
47.     With ThisWorkbook.Sheets("统计表1")
    
48.         brr = .UsedRange
    
49.         For i = 6 To UBound(brr)
    
50.             s = brr(i, 1)
    
51.             If d.exists(s) Then
    
52.                 For j = 1 To UBound(brr, 2)
    
53.                     brr(i, j) = arr(d(s), j)
    
54.                 Next
    
55.             End If
    
56.         Next
    
57.         .UsedRange = brr
    
58.     End With
    
59.     Application.ScreenUpdating = True
    
60. End Sub
    

复制代码

mmwwdd

ykcbf1100 发表于 2024-2-20 16:52
你这个也不用去精确查找啊，用字典就行。

附件供参考。。。

错了，那文件名挺长，我给删除短了

ykcbf1100

mmwwdd 发表于 2024-2-20 16:57
错了，那文件名挺长，我给删除短了

有多长？超过255个字符？

ykcbf1100

mmwwdd 发表于 2024-2-20 16:57
错了，那文件名挺长，我给删除短了

文件名长没关系，只要能打开就行，数据处理其实用不到文件名。

ncow

mmwwdd 发表于 2024-2-20 16:45
看看我的附件

试试
If InStr(Myname, .Cells(i, 1).Value) > 0 And Len(Myname) = Len(.Cells(i, 1).vlaue) Then

mmwwdd

ykcbf1100 发表于 2024-2-20 17:01
文件名长没关系，只要能打开就行，数据处理其实用不到文件名。

谢谢大佬的回复，感谢！