如何用VBA替代VLOOKUP函数

2285343932

想学着用VBA替代VLOOKU函数，请大虾指教:

学生甲1

find函数。

白云2011

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Application.EnableEvents = False
   
3. If Target.Column = 1 Then
   
4. Dim s, i&, n$
   
5. n = Target.Value
   
6. i = Sheets("订单明细").Range("a" & Cells.Rows.Count).End(3).Row
   
7. s = Sheets("订单明细").Range("a1:j" & i)
   
8.   For i = 2 To UBound(s)
   
9.    If s(i, 1) = n Then
   
10.    Range("b" & Target.Row & ":j" & Target.Row) = Sheets("订单明细").Range("b" & i & ":j" & i).Value
    
11.    i = UBound(s)
    
12.    End If
    
13.   Next
    
14. End If
    
15. Application.EnableEvents = True
    
16. End Sub

复制代码

2285343932

羡慕啊！问题是，俺菜鸟！
3F的大虾能不能把上面的代码遂行解释，学起来会比较轻松！
另外，当订单号码为空时，B列至G列的对应数据亦为空，应该怎么写代码？
以上谢谢！

白云2011

Dim s, i&, n$
n = Target.Value
Range("b" & Target.Row & ":j" & Target.Row) = ""
'-------------方法1上面多一句.  方法2下面多个个+1
i = Sheets("订单明细").Range("a" & Cells.Rows.Count).End(3).Row + 1
-------Worksheet_Change时间代码放在对应工作表代码编辑栏中
If Target.Column = 1 Then(如果是第一列即运行下面代码)
n = Target.Value(编码的值)
For i = 2 To UBound(s)(循环数组)
If s(i, 1) = n Then(数组编码与你填的编码核对如果一样那么运行下面代码)
Range("b" & Target.Row & ":j" & Target.Row) = Sheets("订单明细").Range("b" & i & ":j" & i).Value
(Target.Row =行的位置)(区域=区域)
i = UBound(s)(让循环结束)
i = 1列最后最后一个非空单元格
s = 把区域放进数组S
更多VBA解释请一下论坛中的精华贴.

443233785

没看懂，用了代碼没有實現樓主所說的現象，能不能說下怎麼用

白云2011

-------Worksheet_Change事件代码放在对应工作表代码编辑栏中

zjs_gz

麻烦白云大虾把表用设好了，弄个附件出来吧。俺这只菜鸟弄了代码还是出来不了！

kwinawyeth

修改了一下，有详细的注释

Private Sub Worksheet_Change(ByVal Target As Range) 'sheet2及本单元格变化执行这个事件（以下代码）
    Application.EnableEvents = False '禁止刷新屏幕，以提高代码运行速度
    If Target.Column = 1 Then '当子过程参数的列为1，及只有第1列的数据变化才执行这个if块的程序
        Dim s, i&, j&, n$ '这里是申明变量，s后面没as 为可变型，i为长整型，相当于i as long。n为字符型 相当于 n as string
        n = Target.Value 'n为单元格的值
        i = Sheets("订单明细").Range("a" & Cells.Rows.Count).End(3).Row 'i为工作表“订单明细”中A列最后一个数据的行号
        s = Sheets("订单明细").Range("a1:j" & i) 's等于A1到J最后一行 这个区域，这时s就是一个数组
        For i = 2 To UBound(s) '从s数组的下表2开始到最后行，ubound是数组上限
            If s(i, 1) = n And n <> "" Then '如果单元格不为空，并且等于数组中相应的项目
                For j = 1 To 6 '循环6列
                    If j > 4 Then '应数据不对应，加一个判断
                        Cells(Target.Row, j + 1) = s(i, j + 3) '把值复制过来
                    Else
                        Cells(Target.Row, j + 1) = s(i, j + 1) '把值复制过来
                    End If
'                    Range("b" & Target.Row & ":j" & Target.Row) = Sheets("订单明细").Range("b" & i & ":j" & i).Value
                Next j
'            i = UBound(s)
            End If
        Next
    End If
    Application.EnableEvents = True '恢复刷屏
End Sub

2285343932

真给力！我们菜鸟有福了！