如何用VBA替代VLOOKUP函数

kwinawyeth

忘了空白的是也空白，加一判断，清除就行了

2285343932

老兄：会者不难，难者不会，“好人做到底！因为喜欢，所以折腾
因为折腾，所以提高 ！”

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为单元格的值


'这儿是加上的-----------
if n="" then
    for j=2 to 7
        cells(target.row,j)=""
    next j
    exit sub
endif
'------------------------------
        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

[ 本帖最后由 kwinawyeth 于 2011-7-30 16:58 编辑 ]

2285343932

感谢：这是本周末最给力的礼物！

白云2011

刚才有事情走开了 谢谢大家

lxz2393

原帖由 kwinawyeth 于 2011-7-30 16:47 发表
Private Sub Worksheet_Change(ByVal Target As Range) 'sheet2及本单元格变化执行这个事件（以下代码）
    Application.EnableEvents = False '禁止刷新屏幕，以提高代码运行速度   
If Target.Column = 1 Then ...

应该是禁止触发事件，不是禁止刷新屏幕。

kwinawyeth

没注意，应该是 Application.ScreenUpdating = False

dragon1020

高明!!学习了!!
不过也发现一个小问题:
        如果在sheet2第1列中一次性粘贴多个订单号码,将会出错.

wss0002

请问：如果数据清单转置一下应如何编写代码呢？

[ 本帖最后由 wss0002 于 2011-7-31 10:02 编辑 ]

summerrain828

看着这里高手如云,真想拜个老师!!