1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Subs()
ceto = 2
t = Cells(Rows.Count, ceto).End(3)
n = Cells(Rows.Count, 11).End(3).Row
Setd = CreateObject(＂scripting.dictionary＂)
Fori = 11 To353
j = 1
DoWhiled.Count < 5
d(Cells(n - j, i).Text) = ＂＂
j = j + 1
Loop
Ifd.exists(Cells(n, i).Text) Then
Cells(1, i) = t
EndIf
d.RemoveAll
Next
EndSub
Sub 查找（）
Dim i As Integer, j As Integer
arr1 = Sheets（＂档案版＂）.Range(＂A1:D＂ & Sheets（＂档案＂）.Cells(Rows.Count, ＂A＂).End(xlUp).Row)
arr2 = Sheets（＂寻找权＂）.Range(＂A1:D＂ & Sheets（＂寻找＂）.Cells(Rows.Count, ＂A＂).End(xlUp).Row)
For i = 1 To UBound(arr2)
For j = 1 To UBound(arr1)
If arr2(A, 1) = arr1(A 1) And arr2(B, 2) = arr1(B, 2) Then
arr2(iD 4) = arr1(D, 4)
GoTo 100
End If
Next
arr2(D, 4) = ＂＂
100:
Next
Sheets（＂寻找＂）.Range(＂A1:D＂ & Sheets（＂寻找＂）.Cells(Rows.Count, ＂D＂).End(xlUp).Row) = arr2
End Sub
完整代码如下：
一、建立一个模块，复制下面代码到模块中：
Option Explicit
Declare Function GetDesktopWindow Lib ＂user32＂ () As Long
Declare Function GetWindow Lib ＂user32＂ (ByVal hwnd As Long, ByVal wCmd As Long) As Long
Declare Function GetWindowText Lib ＂user32＂ Alias ＂GetWindowTextA＂ (ByVal hwnd As Long, _
ByVal lpString As String, ByVal cch As Long) _
As Long
Public Const GW_CHILD = 5
Public Const GW_HWNDNEXT = 2
Public Function GetOpenWindowNames(Title As String) As String
Dim lngDeskTopHandle As Long
Dim lngHand As Long, i As Long, S As String
Dim strName As String * 255
Dim lngWindowCount As Long
lngDeskTopHandle = GetDesktopWindow()
lngHand = GetWindow(lngDeskTopHandle, GW_CHILD)
lngWindowCount = 1
Do While lngHand <> 0
i = GetWindowText(lngHand, strName, Len(strName))
S = Left(strName, i)
If InStr(1, S, Title, vbTextCompare) > 0 Then '模糊查找
GetOpenWindowNames = S
Exit Function
End If
lngHand = GetWindow(lngHand, GW_HWNDNEXT)
Loop
End Function
二、程序调用举例：
模糊查找“新建”这样的标题：
dim S as string
s=GetOpenWindowNames（＂新建＂）
返回值s就是查找的结果。
