|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
Sub 查找()
Dim arr, i&, ii&
Application.ScreenUpdating = False '关闭屏幕更新
oend = Cells(Cells.Rows.Count, 1).End(xlUp).Row
For i = 1 To oend
If Cells(i, 8).Value = "表名" Then orow = i + 1: Exit For
Next i
For i = Columns.Count To 1 Step -1 '查找列号
If InStr(Cells(orow - 1, i).Value, "此表是否用到") > 0 Then ocol = i
If InStr(Cells(orow - 1, i).Value, "此字段是否用到") > 0 Then ocoln = i
Next
If ocol < 9 Or oend <= orow Or ocol < ocoln Then Exit Sub
arr = Range(Cells(orow, 8), Cells(oend, ocol)) '将记录装入数组
Set d = CreateObject("Scripting.Dictionary") '建立字典
For i = 1 To UBound(arr)
If arr(i, ocoln) = "是" Then d(arr(i, 1)) = "是"
Next i
For i = 1 To UBound(arr)
If d(arr(i, 1)) = "是" Then arr(i, ocol) = "是" Else arr(i, ocol) = "否"
Next i
Cells(orow, 8).Resize(UBound(arr), UBound(arr, 2)) = arr '将数组放入工作表
Application.ScreenUpdating = True '屏幕更新
End Sub
请上传附件吧! |
|