如何用VBA实现快速检索信息（即查询）

zhaogang1960

baigangliao 发表于 2014-1-13 10:15
谢谢！赵老师：我想把1-12月按姓名汇总怎么办呢？sheet1改1月其它以此类推

1. Sub Macro1()
   
2.     Dim arr, brr(1 To 60000, 1 To 8), crr(), i&, j&, l&, m&, n&, sh As Worksheet, d As Object
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     For Each sh In Sheets
   
5.         If sh.Name <> "汇总" Then
   
6.             arr = sh.[a1].CurrentRegion
   
7.             For l = 1 To 16 Step 8
   
8.                 For i = 4 To UBound(arr)
   
9.                     r = d(arr(i, l) & arr(i, l + 1))
   
10.                     If r = "" Then
    
11.                         m = m + 1
    
12.                         d(arr(i, l) & arr(i, l + 1)) = m
    
13.                         n = 0
    
14.                         For j = l To l + 6
    
15.                             n = n + 1
    
16.                             If n = 5 Then
    
17.                                 brr(m, n) = arr(i, 4) * 20
    
18.                             Else
    
19.                                 brr(m, n) = arr(i, j)
    
20.                             End If
    
21.                         Next
    
22.                     Else
    
23.                         n = 2
    
24.                         For j = l + 2 To l + 6
    
25.                             n = n + 1
    
26.                             If n = 5 Then
    
27.                                 brr(r, n) = brr(r, n) + arr(i, 4) * 20
    
28.                             Else
    
29.                                 brr(r, n) = brr(r, n) + arr(i, j)
    
30.                             End If
    
31.                         Next
    
32.                     End If
    
33.                 Next
    
34.             Next
    
35.         End If
    
36.     Next
    
37.     n = WorksheetFunction.RoundUp(m / 2, 0)
    
38.     For i = 1 To n
    
39.         brr(i, 8) = brr(i, 3) + brr(i, 4) + brr(i, 5) - brr(i, 6) + brr(i, 7)
    
40.     Next
    
41.     ReDim crr(n + 1 To m, 1 To 8)
    
42.     For i = n + 1 To m
    
43.         For j = 1 To 7
    
44.             crr(i, j) = brr(i, j)
    
45.         Next
    
46.         crr(i, 8) = crr(i, 3) + crr(i, 4) + crr(i, 5) - crr(i, 6) + crr(i, 7)
    
47.     Next
    
48.     With Sheets("汇总")
    
49.         .UsedRange.Offset(3).ClearContents
    
50.         .[a4].Resize(n, 8) = brr
    
51.         .[i4].Resize(n, 8) = crr
    
52.         .Activate
    
53.     End With
    
54. End Sub
    

复制代码

zhaogang1960

请测试附件
考勤工资明细.rar (12.45 KB, 下载次数: 75)

2014-1-13 21:51 上传

点击文件名下载附件

zzjgll2018

zhaogang1960 发表于 2014-1-13 21:52
请测试附件

赵老师，你好，我是刚学VBA的小白，工作中有一个想法想用VBA实现，就是设计一个VBA界面，通过对关键参数的设置，可以实现精准查找。找到后是一个excel或者word的超链接，我可以直接打开，进行后序的查看。要精准查找的是excel或者word文件里所有的内容。当然这些excel和word文件我会把他们整理归类好放置在文件夹里（文件夹不止一层）。这个想法能实现吗赵老师，麻烦给我点指引和方法，剩下的我自己去对应模块学习，谢谢。

lsc900707

zzjgll2018 发表于 2018-6-10 08:17
赵老师，你好，我是刚学VBA的小白，工作中有一个想法想用VBA实现，就是设计一个VBA界面，通过对关键参数 ...

请直接开新帖。

zzjgll2018

lsc900707 发表于 2018-6-10 09:12
请直接开新帖。

谢谢版主提醒，已开新帖