Hỗ trợ đoạn code VBA xuất ra dữ liệu tại nhiều cột trong Excel

N

Nguyễn Minh Long

Yêu THVBA
K/g diễn đàn!
Mình mô tả vấn đề của mình như sau:
File mình có 02 sheet (SHEET THUCHIEN và Tờ BD 35)
Mình có tạo 1 bảng các thông tin cần truy xuất ra tại sheet SHEET THUCHIEN.
Sau khi mình search tìm kiếm tên hộ dân tại cột A1 xong, các giá trị cần truy xuất sẽ ra theo bảng đã đặt công thức.
Tuy nhiên tại cột E13 của SHEET THUCHIEN, dữ liệu được lấy từ sheet Tờ BD 35 chứa rất nhiều cột (từ cột D đến cột BH), nên mình không thể làm công thức hàm excel xuất ra các quyết định bổ sung tại cột E13 của SHEET THUCHIEN sao cho các quyết định bổ sung cách nhau bởi dấu phẩy.
Nhờ diễn đàn hỗ trợ mình code VBA hay công thức excel để xuất ra được thông tin các số quyết định bổ sung tại cột E13 của SHEET THUCHIEN.
Chân thành cám ơn diễn đàn.
Bạn cần đăng nhập để thấy link

Bạn cần đăng nhập để thấy hình ảnh

Bạn cần đăng nhập để thấy hình ảnh

Bạn cần đăng nhập để thấy hình ảnh
 
Sửa lần cuối:
V

vothanhthu

Guest
Bạn thử code này thêm vào Module nào cũng được, Rồi dùng hàm VlookUpH(Giá trị tra cứu, Vùng dữ liệu) tại ô E13
Mã: 
=VlookUpH(C13,'Tờ BĐ 35'!$B$8:$BD$577)
Mã: 
Function VlookUpH(lookup_value, lookup_range As Range)
    Dim x As Range
    Dim i As Long
    Dim result As String
    result = ""

    'Chạy dò tìm trong vùng dữ liệu
    For Each x In lookup_range
        If x = lookup_value Then 'Nếu tìm thấy giá trị cần dò thì
            For i = 1 To lookup_range.Columns.Count   'Chạy i để điền cột
                If x.Offset(0, i) = "" Then GoTo TTheo 'Nếu rổng thì bỏ qua
                result = result & ", " & x.Offset(0, i) 'Điền giá trị nếu không rỗng
TTheo:            Next i
        End If
    Next
    VlookUpH = Right(result, Len(result) - 2)
End Function
Code này mình biến tấu từ hàm VlookUp dò tìm trả về dấu phẩy theo cột nên sẽ hơi chậm do truyển dữ liệu nhiều ở 2 vòng lặp For, Dùng Arr sẽ nhanh hơn. Nhưng mình thấy bạn dữ liệu không quá khủng bố nên mình nghĩ nó không ảnh hưởng mấy
 
Sửa lần cuối bởi điều hành viên:
N

Nguyễn Minh Long

Yêu THVBA
vothanhthu nói:
Bạn thử code này thêm vào Module nào cũng được, Rồi dùng hàm VlookUpH(Giá trị tra cứu, Vùng dữ liệu) tại ô E13
Mã: 
=VlookUpH(C13,'Tờ BĐ 35'!$B$8:$BD$577)
Mã: 
Function VlookUpH(lookup_value, lookup_range As Range)
    Dim x As Range
    Dim i As Long
    Dim result As String
    result = ""

    'Chạy dò tìm trong vùng dữ liệu
    For Each x In lookup_range
        If x = lookup_value Then 'Nếu tìm thấy giá trị cần dò thì
            For i = 1 To lookup_range.Columns.Count   'Chạy i để điền cột
                If x.Offset(0, i) = "" Then GoTo TTheo 'Nếu rổng thì bỏ qua
                result = result & ", " & x.Offset(0, i) 'Điền giá trị nếu không rỗng
TTheo:            Next i
        End If
    Next
    VlookUpH = Right(result, Len(result) - 2)
End Function
Code này mình biến tấu từ hàm VlookUp dò tìm trả về dấu phẩy theo cột nên sẽ hơi chậm do truyển dữ liệu nhiều ở 2 vòng lặp For, Dùng Arr sẽ nhanh hơn. Nhưng mình thấy bạn dữ liệu không quá khủng bố nên mình nghĩ nó không ảnh hưởng mấy
Nhấn để mở rộng...
Thanks bạn nhiều ah.
 
N

Nguyễn Minh Long

Yêu THVBA
vothanhthu nói:
Bạn thử code này thêm vào Module nào cũng được, Rồi dùng hàm VlookUpH(Giá trị tra cứu, Vùng dữ liệu) tại ô E13
Mã: 
=VlookUpH(C13,'Tờ BĐ 35'!$B$8:$BD$577)
Mã: 
Function VlookUpH(lookup_value, lookup_range As Range)
    Dim x As Range
    Dim i As Long
    Dim result As String
    result = ""

    'Chạy dò tìm trong vùng dữ liệu
    For Each x In lookup_range
        If x = lookup_value Then 'Nếu tìm thấy giá trị cần dò thì
            For i = 1 To lookup_range.Columns.Count   'Chạy i để điền cột
                If x.Offset(0, i) = "" Then GoTo TTheo 'Nếu rổng thì bỏ qua
                result = result & ", " & x.Offset(0, i) 'Điền giá trị nếu không rỗng
TTheo:            Next i
        End If
    Next
    VlookUpH = Right(result, Len(result) - 2)
End Function
Code này mình biến tấu từ hàm VlookUp dò tìm trả về dấu phẩy theo cột nên sẽ hơi chậm do truyển dữ liệu nhiều ở 2 vòng lặp For, Dùng Arr sẽ nhanh hơn. Nhưng mình thấy bạn dữ liệu không quá khủng bố nên mình nghĩ nó không ảnh hưởng mấy
Nhấn để mở rộng...
Mấy cái chữ tiếng việt sao mình đánh trong code nó lỗi font chữ ah ban, minh chỉnh các loại mà ko dc
 
N

Nguyễn Minh Long

Yêu THVBA
vothanhthu nói:
Là do hiển thị Font thôi bạn, bạn chỉnh trong Tool>Option. Nhưng nó không ảnh hưởng gì code đâu !
Nhấn để mở rộng...
Mình bấm ALT + F11, xong mình chọn module1, paste đoạn code của bạn vào,
Xong bấm Ctrl+S Save lại, rồi bấm Alt+Q đóng VBA lại.
Nhưng mỗi lần search tên hộ dân là Excel treo máy luôn bạn ah
 
Euler

Euler

Administrator
Thành viên BQT
Nếu viết tiếng việt trực tiếp vào trong code, thì có trường hợp xảy ra lỗi. Cách code này thường gặp rất nhiều trên GPE.
Hiện nay tuhocvba.net đã phát triển một topic để giải quyết việc này.
Bạn cần đăng nhập để thấy link

Tôi thông báo cho bạn @Nguyễn Minh Long biết rằng, bạn nên sử dụng cấu trúc @tên_nick để gọi/nhắn ai đó, thay vì cứ tươngng cái nút Quote. Cứ bài người trước thì bạn lôi vào bài của bạn.
Nếu còn một lần nữa, chúng tôi sẽ thực hiện xóa nick bạn.
 
V

vothanhthu

Guest
Nguyễn Minh Long
Bạn thử sửa công thức ô E13 lại giúp mình.
Mã: 
=VlookUpH(A1,'Tờ BĐ 35'!$B$8:$BD$577)
Code Function bạn thêm thuộc tính String cho lookup_value. Sửa lại For i = 2 thay vì i = 1 cho trường hợp của bạn (Bỏ qua QĐ chính).
Mã: 
Function VlookUpH(lookup_value As String, lookup_range As Range)
    Dim x As Range
    Dim i As Long
    Dim result As String
    result = ""

    'Chạy dò tìm trong vùng dữ liệu
    For Each x In lookup_range
        If x = lookup_value Then 'Nếu tìm thấy giá trị cần dò thì
            For i = 2 To lookup_range.Columns.Count   'Chạy i để điền cột
                If x.Offset(0, i) = "" Then GoTo TTheo 'Nếu rổng thì bỏ qua
                result = result & ", " & x.Offset(0, i) 'Điền giá trị nếu không rỗng
TTheo:            Next i
        End If
    Next
    VlookUpH = Right(result, Len(result) - 2)
End Function
Chổ gợi ý nhập liệu, bạn hủy code lúc trước mình làm. Bạn dùng Addin này giúp mình, sử dụng Addin tại Tab Data
Theo mình kiểm tra thì sau khi thao tác hết các bước trên thì file đã hết lỗi
Nhưng nếu bạn thấy vẫn còn lỗi thì báo cho mình biết nhé !
Bạn cần đăng nhập để thấy link
 
Sửa lần cuối bởi điều hành viên:
Bạn phải đăng nhập hoặc đăng ký để bình luận.
Top