他山之石——使用VBA进行单元格查找（Find/Match with VBA）

这节对我的启发是，是否可使用Find/Match或其他方法来替代worksheetfunction.vlookup方法，从而提高工作中的一个报表的生成速度（目前耗时45分钟左右）。似乎可以用字典+数组的方法得到最高的性能，要不要试一试？这是个问题。

Option Explicit

'1 使用循环查找 (在单元格中查找效率太低)

'2 调用工作表函数
  
    Sub c1() '判断是否存在,并查找所在行数
      Dim hao As Integer
      Dim icount As Integer
      icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])
      If icount > 0 Then
       MsgBox "该入库单号码已经存在，请不要重复录入"
       MsgBox Application.WorksheetFunction.Match([g3], Sheets("库存明细表").[b:b], 0)
      End If
    End Sub
    
    
'3 使用Find方法

    Sub c2()
      Dim r As Integer, r1 As Integer
      Dim icount As Integer
      icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])
      If icount > 0 Then
       r = Sheets("库存明细表").[b:b].Find(Range("G3"), Lookat:=xlWhole).Row '查找号码第一次出现的位置
       r1 = Sheets("库存明细表").[b:b].Find([g3], , , , , xlPrevious).Row
       MsgBox r & ":" & r1
      End If
    End Sub
 

   Sub c3() '返回最下一行非空行的行数
    
      MsgBox Sheets("库存明细表").Cells.Find("*", , , , , xlPrevious).Row
    
   End Sub

Option Explicit
Sub 输入()
  Dim c As Integer   '号码在库存表中的个数
  Dim r As Integer   '入库单的数据行数
  Dim cr As Integer  '库存明细表中第一个空行的行数
With Sheets("库存明细表")
    c = Application.CountIf(.[b:b], Range("g3"))
    If c > 0 Then
       MsgBox "该单据号码已经存在！,请不要重复录入"
       Exit Sub
    Else
       r = Application.CountIf(Range("b6:b10"), "<>")
       cr = .[b65536].End(xlUp).Row + 1
       .Cells(cr, 1).Resize(r, 1) = Range("e3")
       .Cells(cr, 2).Resize(r, 1) = Range("g3")
       .Cells(cr, 3).Resize(r, 1) = Range("c3")
       .Cells(cr, 4).Resize(r, 6) = Cells(6, 2).Resize(r, 6).Value
       MsgBox "输入已完成"
    End If
 End With
End Sub

Sub 查找()
  Dim c As Integer   '号码在库存表中的个数
  Dim r As Integer   '入库单的数据行数
  
With Sheets("库存明细表")
    c = Application.CountIf(.[b:b], Range("g3"))
    If c = 0 Then
       MsgBox "该单据号码不存在！"
       Exit Sub
    Else
        r = .[b:b].Find(Range("g3"), , , , , xlNext).Row
        Range("c3") = .Cells(r, 3)
        Range("e3") = .Cells(r, 1)
        Cells(6, 2).Resize(c, 5) = .Cells(r, 4).Resize(c, 5).Value
       MsgBox "查询已完成"
    End If
 End With
End Sub

Sub 删除()
 Dim c As Integer   '号码在库存表中的个数
  Dim r As Integer   '入库单的数据行数
  
With Sheets("库存明细表")
    c = Application.CountIf(.[b:b], Range("g3"))
    If c = 0 Then
       MsgBox "该单据号码不存在！"
       Exit Sub
    Else
        r = .[b:b].Find(Range("g3"), , , , , xlNext).Row
        .Range(r & ":" & c + r - 1).Delete
       MsgBox "删除已完成"
    End If
 End With
End Sub
Sub 修改()
  Call 删除
  Call 输入
End Sub