Trang 1/13 1 2 3 4 5 11 ... cuốicuối
Hiển thị kết quả tìm kiếm từ 1 đến 10 trên tổng số: 126

Ðề tài: Xin viết dùng mã vba thay thế cho hàm vlookup

  1. Xin viết dùng mã vba thay thế cho hàm vlookup

    Mình gửi vd lên nhờ các bắc bớt chút thời gian chỉ dùm vài chiêu
    Cảm ơn các bạn nhiều!!!
    Tập tin đính kèm Tập tin đính kèm

  2. Trích Nguyên văn bởi hoangvinh_tb View Post
    Mình gửi vd lên nhờ các bắc bớt chút thời gian chỉ dùm vài chiêu
    Cảm ơn các bạn nhiều!!!
    Mã nó đây
    RightClick vào sheet "CT" ==> View Code chép cái này vào
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim d, I, Vung, Ws
        Set d = CreateObject("scripting.dictionary")
        Set Ws = Sheets("MA")
        Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
            If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
                If Target.Count = 1 Then
                    For I = 1 To UBound(Vung)
                        d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                    Next I
                        If d.exists(UCase(Target.Value)) Then
                            Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                            Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                        End If
                End If
             End If
    End Sub
    Thân

  3. Cái ni cũng vừa đủ sòai nề

    PHP Code:
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
     If 
    Not Intersect(TargetRange("B4:B99")) Is Nothing Then
        Dim Rng 
    As RangesRng As RangeSh As Worksheet
        
        Set Sh 
    ThisWorkbook.Worksheets("MA")
        
    Set Rng Sh.Range(Sh.[b2], Sh.[b2].End(xlDown))
        
    Set sRng Rng.Find(Target.Value, , xlFormulasxlWhole)
        If 
    sRng Is Nothing Then
            MsgBox 
    "Nothing"
        
    Else
            
    Target.Offset(, 1).Resize(, 2).Value sRng.Offset(, 1).Resize(, 2).Value
        End 
    If
     
    End If
    End Sub 
    0909 127 085

  4. Cám ơn bạn đã gửi cho mình đoạn mã này! nhưng mình muốn triển khai đoạn mã đó mà vẫn chưa làm đc mong bạn giải thích và giúp mình nhé
    Mình muốn cột địa chỉ di chuyển các cột tên khoảng 5 cột

  5. #5
    Trích Nguyên văn bởi hoangvinh_tb View Post
    Cám ơn bạn đã gửi cho mình đoạn mã này! nhưng mình muốn triển khai đoạn mã đó mà vẫn chưa làm đc mong bạn giải thích và giúp mình nhé
    Mình muốn cột địa chỉ di chuyển các cột tên khoảng 5 cột
    5 cột ấy là những cột nào vậy bạn ? Nhiều người trên diễn đàn (trong đó có tôi) cho rằng hỏi bài mà không gửi file đính kèm và không diễn đạt rõ yêu cầu là thiếu trách nhiệm với câu hỏi của mình và thiếu tôn trọng người mình hỏi.
    Hỏi thì ngại mọi người chê mình dốt mà không hỏi thì sẽ dốt cả đời ???. Học hỏi là để vượt qua chính mình.

  6. Trích Nguyên văn bởi TrungChinhs View Post
    5 cột ấy là những cột nào vậy bạn ? Nhiều người trên diễn đàn (trong đó có tôi) cho rằng hỏi bài mà không gửi file đính kèm và không diễn đạt rõ yêu cầu là thiếu trách nhiệm với câu hỏi của mình và thiếu tôn trọng người mình hỏi.
    cám ơn bạn đã góp chân thành mình cũng định gửi file đính kèm mà không có cách nào đính kèm đc mong bạn và các bạn trong diễn đàn thông cảm.

  7. Trích Nguyên văn bởi concogia View Post
    Mã nó đây
    RightClick vào sheet "CT" ==> View Code chép cái này vào
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim d, I, Vung, Ws
        Set d = CreateObject("scripting.dictionary")
        Set Ws = Sheets("MA")
        Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
            If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
                If Target.Count = 1 Then
                    For I = 1 To UBound(Vung)
                        d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                    Next I
                        If d.exists(UCase(Target.Value)) Then
                            Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                            Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                        End If
                End If
             End If
    End Sub
    Thân
    Mình cũng đang cần cái này, cảm ơn pro. cái này hay lắm. Mình làm cửa hàng bán lẻ, hằng ngày phải xuất kho tương đối nhiều phiếu giao hàng trong 1 thời gian ngắn. Dùng hàm vlookup file excel lên đến 150MB nhìn đã thấy khiếp. đang tìm mã vba để thay thế vlookup. Thank pro nhé.

  8. Trích Nguyên văn bởi concogia View Post
    Mã nó đây
    RightClick vào sheet "CT" ==> View Code chép cái này vào
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim d, I, Vung, Ws
        Set d = CreateObject("scripting.dictionary")
        Set Ws = Sheets("MA")
        Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
            If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
                If Target.Count = 1 Then
                    For I = 1 To UBound(Vung)
                        d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                    Next I
                        If d.exists(UCase(Target.Value)) Then
                            Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                            Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                        End If
                End If
             End If
    End Sub
    Thân
    code này hay, lâu nay mình lại dùng 2 vòng for hèn gì mà khi dữ liệu nhiều thì tìm kiếm lâu lắc.
    ==============================================
    Sau khi thử code trên mình thấy chỉ tìm kiếm được cho từng mã khi click vào ô đó (tức là nhập vào giá trị mã cho ô đó thì sẽ tìm kiếm cho mã tại ô đó). Vậy nếu mình có sẵn 1 danh sách mã và muốn tìm kiếm cho 1 danh sách mã đó thì ko lẽ phải click từng mã mới tìm kiếm được. Mình vẫn phải dùng 2 vòng For, 1 vòng for cho vùng chứa dữ liệu tìm kiếm và 1 vòng for cho vùng chứa mã muốn tìm kiếm. Với cách này dữ liệu hàng chục ngàn dòng thì code chạy lâu, có cách nào khác không nhỉ?
    PHP Code:
    Sub TimKiem_Vlookup()
    Dim i As LongAs LongsArray1sArray2Arr()
    With Sheets("MA")
        
    sArray1 = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value
    End With
    With Sheets
    ("CT")
        .
    Range("C4:D65000").ClearContents
        sArray2 
    = .Range(.[B4], .[B65000].End(xlUp)).Value
        ReDim Arr
    (1 To UBound(sArray21), 1 To 2)
    For 
    1 To UBound(sArray21)
        For 
    1 To UBound(sArray11)
            If 
    Not IsEmpty(sArray2(j1)) And sArray1(i1) = UCase(sArray2(j1)) Then
                Arr
    (j1) = sArray1(i2)
                
    Arr(j2) = sArray1(i3)
            
    End If
        
    Next
    Next
    .Range("C4").Resize(12).Value Arr
    End With
    End Sub 
    thay đổi nội dung bởi: qtm1987, 13-04-12 lúc 10:22 AM Lý do: Thắc mắc muốn hỏi thêm về tìm kiếm

  9. Sửa giúp em cái này với Bác 'CONCOGIA'

    Trích Nguyên văn bởi concogia View Post
    Mã nó đây
    RightClick vào sheet "CT" ==> View Code chép cái này vào
    Code:
    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim d, I, Vung, Ws
        Set d = CreateObject("scripting.dictionary")
        Set Ws = Sheets("MA")
        Vung = Ws.Range(Ws.[B3], Ws.[B10000].End(xlUp)).Resize(, 3)
            If Not Intersect(Target, Range("B4:B1000")) Is Nothing Then
                If Target.Count = 1 Then
                    For I = 1 To UBound(Vung)
                        d.Add Vung(I, 1), Array(Vung(I, 2), Vung(I, 3))
                    Next I
                        If d.exists(UCase(Target.Value)) Then
                            Target.Offset(, 1) = d.Item(UCase(Target.Value))(0)
                            Target.Offset(, 2) = d.Item(UCase(Target.Value))(1)
                        End If
                End If
             End If
    End Sub
    Thân
    Chào bác concogia và các cao thủ.
    EM đang cần làm 1 cái phiếu xuất kho cũng thay thế hàm vlookup bằng mã VBA, copy mã của bác concogia về chạy thử thì rất ok. Chỉ có điều em muốn link thêm giá trị từ Sheet 'MA' sang sheet 'CT', mà ko biết sửa thế nào nhờ bác concogia và các cao thủ sử giúp. Em xin cảm ơn các bác.
    Tập tin đính kèm Tập tin đính kèm

  10. Trích Nguyên văn bởi qtm1987 View Post
    code này hay, lâu nay mình lại dùng 2 vòng for hèn gì mà khi dữ liệu nhiều thì tìm kiếm lâu lắc.
    ==============================================
    Sau khi thử code trên mình thấy chỉ tìm kiếm được cho từng mã khi click vào ô đó (tức là nhập vào giá trị mã cho ô đó thì sẽ tìm kiếm cho mã tại ô đó). Vậy nếu mình có sẵn 1 danh sách mã và muốn tìm kiếm cho 1 danh sách mã đó thì ko lẽ phải click từng mã mới tìm kiếm được. Mình vẫn phải dùng 2 vòng For, 1 vòng for cho vùng chứa dữ liệu tìm kiếm và 1 vòng for cho vùng chứa mã muốn tìm kiếm. Với cách này dữ liệu hàng chục ngàn dòng thì code chạy lâu, có cách nào khác không nhỉ?
    PHP Code:
    Sub TimKiem_Vlookup()
    Dim i As LongAs LongsArray1sArray2Arr()
    With Sheets("MA")
        
    sArray1 = .Range(.[B3], .[B65000].End(xlUp)).Resize(, 3).Value
    End With
    With Sheets
    ("CT")
        .
    Range("C4:D65000").ClearContents
        sArray2 
    = .Range(.[B4], .[B65000].End(xlUp)).Value
        ReDim Arr
    (1 To UBound(sArray21), 1 To 2)
    For 
    1 To UBound(sArray21)
        For 
    1 To UBound(sArray11)
            If 
    Not IsEmpty(sArray2(j1)) And sArray1(i1) = UCase(sArray2(j1)) Then
                Arr
    (j1) = sArray1(i2)
                
    Arr(j2) = sArray1(i3)
            
    End If
        
    Next
    Next
    .Range("C4").Resize(12).Value Arr
    End With
    End Sub 
    Code trên là viết theo đề bài của bạn hoangvinh_tb, còn nếu theo ý của bạn thì ta vẫn viết theo cách cũ + một vòng lặp For ...... Next nữa, tức là một vòng tạo Dictionary, một vòng lấy mảng kết quả
    Cách của bạn là 2 vòng ......lồng vào nhau, dữ liệu càng lớn thì tốc độ càng của nó làm bạn........."hao thuốc lá + cà phê đá"
    Mình chỉ nghĩ thế thôi ( trên lý thuyết) vì không có file thực tế để thử ( làm biếng tạo file quá )
    Thân

Trang 1/13 1 2 3 4 5 11 ... cuốicuối

Thông tin về chủ đề này

Users Browsing this Thread

Hiện có 1 người đang xem đề tài này. (0 thành viên và 1 khách)

Bookmarks

Bookmarks

Quyền Sử Dụng Ở Diễn Ðàn

  • Bạn không thể đăng đề tài mới
  • Bạn không thể đăng trả lời
  • Bạn không thể đăng file đính kèm.
  • Bạn không thể sửa bài viết.
  •