入库单的输入，查找，删除与修改
一 查找功能
在VBA中查找主要有三种方法，第一是使用循环查找（在单元格中查找效率太低）第二种是调用工作表函数，第三是使用find函数。
1.1 调用工作表函数查找
Sub haa1()
Dim hao As Integer
Dim icount As Integer
icount = Application.WorksheetFunction.CountIf(Sheets("库存明细表").[b:b], [g3])
If icount > 0 Then ‘1.涉及到查找单据号码在库存明细表中是否存在
MsgBox "该入库单已存在，请不要重复录入"
MsgBox Application.WorksheetFunction.Match([g3], Sheets("库存明细表").[b:b], 0) ’2.在库存明细表中查找单据号码第一次出现的位置
End If
End Sub
涉及到match函数
以下信息选自https://zhidao.baidu.com/question/514555586.html
MATCH函数语法：MATCH(lookup_value, lookup_array, match_type)
lookup_value：需要在数据表（lookup_array）中查找的值。可以为数值（数字、文本或逻辑值）或对数字、文本或逻辑值的单元格引用。可以包含通配符、星号 (*) 和问号 (?)。星号可以匹配任何字符序列；问号可以匹配单个字符。
lookup_array：可能包含有所要查找数值的连续的单元格区域，区域必须是某一行或某一列，即必须为一维数据，引用的查找区域是一维数组。
match_type：表示查询的指定方式，用数字-1、0或者1表示。
为1时，查找小于或等于lookup_value的最大数值在lookup_array中的位置，lookup_array必须按升序排列：
为0时，查找等于lookup_value的第一个数值，lookup_array按任意顺序排列：
为-1时，查找大于或等于lookup_value的最小数值在lookup_array中的位置，lookup_array必须按降序排列。利用MATCH函数查找功能时，当查找条件存在时，MATCH函数结果为具体位置（数值），否则显示#N/A错误。
MATCH函数：匹配函数,指返回指定数值在指定数组区域中的位置。MATCH函数是EXCEL主要的查找函数之一，该函数通常有以下几方面用途：
(1)确定列表中某个值的位置；
(2)对某个输入值进行检验，确定这个值是否存在某个列表中；
(3)判断某列表中是否存在重复数据；
(4)定位某一列表中最后一个非空单元格的位置。
1.2 使用find函数查找
Sub haa2()
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([g3], lookat:=xlWhole).Row
r1 = Sheets("库存明细表").[b:b].Find([g3], searchdirection:=xlPrevious).Row
'在库存明细表中查找单据号码最后一个的位置。
MsgBox r & ":" & r1
End If
End Sub
如何返回最下一行非空行的行数
Sub haa3()
MsgBox Sheets("库存明细表").Cells.Find("*", searchdirection:=xlPrevious).Row
End Sub
涉及到find函数。
以下信息摘选自http://www.excelpx.com/thread-156406-1-1.html
有关在 Visual Basic 中使用 Find 工作表函数的详细信息，请参阅F1帮助中在 Visual Basic 中使用工作表函数。
expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SerchFormat)
expression 必需。该表达式返回一个 Range 对象。
What Variant 类型，必需。要搜索的数据。可为字符串或任意 Microsoft Excel 数据类型。
After Variant 类型，可选。表示搜索过程将从其之后开始进行的单元格。此单元格对应于从用户界面搜索时的活动单元格位置。值得注意的是，After 必须是区域中的单个单元格。请记住搜索是从该单元格之后 开始的；直到本方法绕回到指定的单元格时，才对其进行搜索。如果未指定本参数，搜索将从区域的左上角单元格之后开始。
LookIn Variant 类型，可选。信息类型。
LookAt Variant 类型，可选。可为以下 XlLookAt 常量之一：xlWhole 或 xlPart。
SearchOrder Variant 类型，可选。可为以下 XlSearchOrder 常量之一：xlByRows 或 xlByColumns。
SearchDirection XlSearchDirection 类型，可选。搜索的方向。
XlSearchDirection 可为以下 XlSearchDirection 常量之一。
xlNext 默认值
xlPrevious
MatchCase Variant 类型，可选。若为 True，则进行区分大小写的查找。默认值为 False。
MatchByte Variant 类型，可选。仅在选择或安装了双字节语言支持时使用。若为 True，则双字节字符仅匹配双字节字符。若为 False，则双字节字符可匹配其等价的单字节字符。
SearchFormat Variant 类型，可选。搜索的格式。
说明每次使用本方法后，参数 LookIn、LookAt、SearchOrder 和 MatchByte 的设置将保存。如果下次调用本方法时不指定这些参数的值，就使用保存的值。设置这些参数将更改“查找和替换”对话框中的设置，如果您忽略参数，更改“查找和替换”对话框中的设置将更改使用的保存值。若要避免这种问题的出现，每次使用该方法时请明确设置这些参数。
可以使用 FindNext和 FindPrevious方法重复搜索。
当搜索到指定的搜索区域的末尾时，本方法将绕回到区域的开始继续搜索。发生绕转后，若要停止搜索，请保存第一个找到的单元格地址，然后依据该保存地址测试每个后续查找到的单元格地址。
若要进行更为复杂的模式匹配查找，请用 For Each...Next 语句和 Like 运算符。例如，下列代码在单元格区域 A1:C5 中搜索字体名称以“Cour”开始的单元格。当 Microsoft Excel 找到匹配单元格以后，就将其字体改为“Times New Roman”。
For Each c In [A1:C5]
If c.Font.Name Like "Cour*" Then
c.Font.Name = "Times New Roman"
End If
Next
--------------------------------------------------------
下面是几个兰色版主以前的教学示例代码：
Sub Find1() '在某列查找
Dim k
k = Range("A:A").Find("A").Row
MsgBox k
End Sub
Sub Find11() '在多列查找
Dim k
k = Range("A:B").Find("BCD").Row
MsgBox k
End Sub
Sub Find2() '查找的起始位置
Dim k
k = Range("A:B").Find("A", AFTER:=Range("A5")).Row
MsgBox k
End Sub
Sub Find3() '在值中查找
Dim k
k = Range("B:B").Find("SE", LookIn:=xlValues).Row
MsgBox k
End Sub
Sub Find31() '在公式中查找
Dim k
k = Range("B:B").Find("C2", LookIn:=xlFormulas).Address
MsgBox k
End Sub
Sub Find32() '在备注中查找
Dim k
k = Range("B:C").Find("AB", LookIn:=xlComments).Address
MsgBox k
End Sub
Sub Find41() '按模糊查找
Dim k
k = Range("B:C").Find("A", LookIn:=xlValues, LOOKAT:=xlPart).Address
MsgBox k
End Sub
Sub Find42() '匹配查找
Dim k
k = Range("B:C").Find("A", LookIn:=xlValues, LOOKAT:=xlWhole).Address
MsgBox k
End Sub
Sub Find5() '按先行后列的方式查找
Dim k
k = Range("A:B").Find("AB", LookIn:=xlValues, LOOKAT:=xlWhole, SEARCHORDER:=xlByRows).Address
MsgBox k
End Sub
Sub Find51() '按先列后行的方式查找
Dim k
k = Range("A:B").Find("AB", LookIn:=xlValues, LOOKAT:=xlWhole, SEARCHORDER:=xlByColumns).Address
MsgBox k
End Sub
Sub Find6() '查找方向(从后向前)
Dim k
k = Range("A:A").Find("A", , xlValues, xlWhole, xlByColumns, xlPrevious).Address
MsgBox k
End Sub
Sub Find61() '查找方向(从前向后)
Dim k
k = Range("A:A").Find("A", , xlValues, xlWhole, xlByColumns, xlNext).Address
MsgBox k
End Sub
Sub Find7() '字母大小写
Dim k
k = Range("a:b").Find("a", , xlValues, xlWhole, xlByColumns, xlNext, False).Address
MsgBox k
End Sub
Sub f7() '查找不到的情况
Dim MRG As Range
Set MRG = Range("A:A").Find("D")
If MRG Is Nothing Then
MsgBox "查找不到字母D"
Else
MsgBox "查找成功,单元格地址为:" & MRG.Address
End If
End Sub
Sub f8() '二次查找
Dim MRG As Range
Set MRG = Range("A:A").Find("A")
Set mrg1 = Range("A:A").FindNext(MRG)
MsgBox mrg1.Address
End Sub
Sub F9() '区域查找
Dim MRG As Range, AAA As String
Set MRG = Range("A1:F16").Find("A")
AAA = MRG.Address
Do
Set MRG = Range("A1:F16").FindNext(MRG)
MsgBox MRG.Address
Loop Until MRG.Address = AAAEnd Sub
二 入库单的输入功能
Sub haa4()
Dim c As Integer '号码在库存表中的个数
Dim r As Integer '入库单的数据行数
Dim cr As Integer ' 库存明细表中第一个空行的行数
With Sheets("库存明细表")
c = Application.CountIf(.[b:b], [g3])
If c > 0 Then
MsgBox "已存在，不要重复录入"
Exit Sub
Else
r = Application.CountIf([b6:b10], "<>") ‘计算b6到b10之间的非空单元格个数
cr = .[b65536].End(xlUp).Row + 1
.Cells(cr, 1).Resize(r, 1) = [e3]
.Cells(cr, 2).Resize(r, 1) = [g3]
.Cells(cr, 3).Resize(r, 1) = [c3]
.Cells(cr, 4).Resize(r, 6) = Cells(6, 2).Resize(r, 6).Value
.Range("a:a").NumberFormat = "yyyy-m-d"
.Range("a1:k10000").HorizontalAlignment = xlCenter
MsgBox "输入完成"
End If
End With
End Sub
三 查找功能
Sub 查找()
Dim x As Integer '单据号码在库存表中的个数
Dim r As Integer '入库单的数据行数
With Sheets("库存明细表")
x = Application.CountIf(.[b:b], [g3])
If x = 0 Then
Exit Sub
Else
r = .[b:b].Find([g3], searchdirection:=xlNext).Row
Cells(3, 3) = .Cells(r, 3)
Cells(3, 5) = .Cells(r, 1)
Cells(6, 2).Resize(x, 5) = .Cells(r, 4).Resize(x, 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], [g3])
If c = 0 Then
MsgBox "不存在 不用删除"
Exit Sub
Else
r = .[b:b].Find([g3], searchdirection:=xlNext).Row
.Range(r & ":" & r + c - 1).Delete
End If
End With
End Sub
五 修改功能
Sub 修改()
Call 删除
Call haa4
End Sub
网友评论