这节对我的启发是,是否可使用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