Xin công thức VBA hàm tìm kiếm và lấy giá trị

Liên hệ QC
N

nvh611

Thành viên thường trực
Tham gia
20/5/17
Bài viết
228
Được thích
42
Nhờ các bạn trên GPE viết giúp hàm như nội dung file đính kèm
Cảm ơn các bạn!
 

File đính kèm

  • hàm tìm giá trị.xlsm
    9.3 KB · Đọc: 19
Sắp xếp theo thời gian sắp xếp theo bầu chọn
HieuCD đã viết:
Làm rỏ hơn:
1/ Cột E không ảnh hưởng đến kết quả ?
2/ Nếu B6=2 thì kết quả như thế nào
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @HieuCD đã quan tâm:
Tất cả các cột đều có liên quan trong vùng dữ liệu vì vậy
1- Cột E cũng có liên quan
2- Nếu như ô B6=2 thì kết quả sẽ như sau
Tôi gửi lại file xin bạn giúp đỡ
Bài đã được tự động gộp:

Ba Tê đã viết:
Không biết mục đích của việc này là sao, Nếu dữ liệu hàng ngàn dòng thì thế nào.
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @Ba Tê công thức gần đúng
Nhưng do mình làm không hết các cột, nên bạn hiểu sai
Bạn sửa giúp mình là nếu cột nào có kết quả thì nối lại
Giống như hàm Sumifs đó bạn.
 

File đính kèm

  • hàm tìm giá trị.xlsm
    9.7 KB · Đọc: 9
Lần chỉnh sửa cuối:
Upvote 0
nvh611 đã viết:
Cảm ơn bạn @HieuCD đã quan tâm:
Tất cả các cột đều có liên quan trong vùng dữ liệu vì vậy
1- Cột E cũng có liên quan
2- Nếu như ô B6=2 thì kết quả sẽ như sau
Tôi gửi lại file xin bạn giúp đỡ
Bài đã được tự động gộp:


Cảm ơn bạn @Ba Tê công thức gần đúng
Nhưng do mình làm không hết các cột, nên bạn hiểu sai
Bạn sửa giúp mình là nếu cột nào có kết quả thì nối lại
Giống như hàm Sumifs đó bạn.
Nhấp chuột vào đây để mở rộng...
Tạo cho bạn Function với số cột tùy ý, xem cách dùng trong File
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range) As Variant
  Dim blArr() As Boolean, Res As String
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    For j = 1 To sCol
      If blArr(j) = False Then
        If InStr(1, VungDk(i, j).Value, tmp) = 0 Then
          k = k + 1: blArr(j) = True
        End If
      End If
    Next j
    If k = sCol Then Exit For
  Next i
  If k < sCol Then
    For j = 1 To sCol
      If blArr(j) = False Then
        If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j)
      End If
    Next j
  End If
  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
 

File đính kèm

  • hàm tìm giá trị.xlsm
    16.7 KB · Đọc: 15
Upvote 0
HieuCD đã viết:
Tạo cho bạn Function với số cột tùy ý, xem cách dùng trong File
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range) As Variant
  Dim blArr() As Boolean, Res As String
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    For j = 1 To sCol
      If blArr(j) = False Then
        If InStr(1, VungDk(i, j).Value, tmp) = 0 Then
          k = k + 1: blArr(j) = True
        End If
      End If
    Next j
    If k = sCol Then Exit For
  Next i
  If k < sCol Then
    For j = 1 To sCol
      If blArr(j) = False Then
        If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j)
      End If
    Next j
  End If
  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @HieuCD
Công thức rất chuẩn
Vậy tôi kính nhờ bạn viết cho trường hợp là "các dòng không liền nhau"
Mong bạn giúp đỡ
 

File đính kèm

  • hàm tìm giá trị (1).xlsm
    15.6 KB · Đọc: 5
Upvote 0
nvh611 đã viết:
Cảm ơn bạn @HieuCD
Công thức rất chuẩn
Vậy tôi kính nhờ bạn viết cho trường hợp là "các dòng không liền nhau"
Mong bạn giúp đỡ
Nhấp chuột vào đây để mở rộng...
Không rỏ ý muốn kết quả như thế nào khi dòng không có dữ liệu, mình qui định xét theo cột điều kiện (cột B)
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range) As Variant
  Dim blArr() As Boolean, Res As String, tmp
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""
  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If InStr(1, VungDk(i, j).Value, tmp) = 0 Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i
  If k < sCol Then
    For j = 1 To sCol
      If blArr(j) = False Then
        If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j)
      End If
    Next j
  End If
  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
 

File đính kèm

  • hàm tìm giá trị (1) (1).xlsm
    15.6 KB · Đọc: 9
Upvote 0
HieuCD đã viết:
Không rỏ ý muốn kết quả như thế nào khi dòng không có dữ liệu, mình qui định xét theo cột điều kiện (cột B)
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range) As Variant
  Dim blArr() As Boolean, Res As String, tmp
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""
  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If InStr(1, VungDk(i, j).Value, tmp) = 0 Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i
  If k < sCol Then
    For j = 1 To sCol
      If blArr(j) = False Then
        If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j)
      End If
    Next j
  End If
  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @HieuCD công thức cũng đã rất đúng
Nhờ bạn chiếu cố giúp tôi lần thứ 3 như file đính kèm
Kính mong sự giúp đỡ của bạn.
Xin chúc bạn buổi tối vui vẻ.
 

File đính kèm

  • hàm tìm giá trị (1) (1).xlsm
    16.7 KB · Đọc: 4
Upvote 0
nvh611 đã viết:
Cảm ơn bạn @HieuCD công thức cũng đã rất đúng
Nhờ bạn chiếu cố giúp tôi lần thứ 3 như file đính kèm
Kính mong sự giúp đỡ của bạn.
Xin chúc bạn buổi tối vui vẻ.
Nhấp chuột vào đây để mở rộng...
Bạn muốn trả kết quả như thế nào? Nhập tay kết quả từng công thức và gởi lại file
 
Upvote 0
HieuCD đã viết:
Bạn muốn trả kết quả như thế nào? Nhập tay kết quả từng công thức và gởi lại file
Nhấp chuột vào đây để mở rộng...
HieuCD đã viết:
Không rỏ ý muốn kết quả như thế nào khi dòng không có dữ liệu, mình qui định xét theo cột điều kiện (cột B)
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range) As Variant
  Dim blArr() As Boolean, Res As String, tmp
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""
  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If InStr(1, VungDk(i, j).Value, tmp) = 0 Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i
  If k < sCol Then
    For j = 1 To sCol
      If blArr(j) = False Then
        If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j)
      End If
    Next j
  End If
  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
Nhấp chuột vào đây để mở rộng...
Nhờ bạn chỉnh lại nghịch đảo của công thức
Cảm ơn bạn @HieuCD
 

File đính kèm

  • hàm tìm giá trị (1) (1).xlsm
    15.5 KB · Đọc: 2
Upvote 0
nvh611 đã viết:
Nhờ bạn chỉnh lại nghịch đảo của công thức
Cảm ơn bạn @HieuCD
Nhấp chuột vào đây để mở rộng...
Xem cách dùng Function trong File
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range, Optional ByVal TypeCond As Boolean = True) As Variant
  'TypeCond=False: Xet dieu kien nguoc lai
  Dim blArr() As Boolean, Res As String, tmp, dk As Boolean
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""
 
  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If InStr(1, VungDk(i, j).Value, tmp) = 0 Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i
 
  For j = 1 To sCol
    If (blArr(j) = False) = TypeCond Then
      If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j) '--------True;False
    End If
  Next j

  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
 

File đính kèm

  • hàm tìm giá trị (1) (1) (2).xlsm
    16.9 KB · Đọc: 4
Upvote 0
HieuCD đã viết:
Xem cách dùng Function trong File
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range, Optional ByVal TypeCond As Boolean = True) As Variant
  'TypeCond=False: Xet dieu kien nguoc lai
  Dim blArr() As Boolean, Res As String, tmp, dk As Boolean
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""

  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If InStr(1, VungDk(i, j).Value, tmp) = 0 Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i

  For j = 1 To sCol
    If (blArr(j) = False) = TypeCond Then
      If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j) '--------True;False
    End If
  Next j

  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn @HieuCD
Công thức trên chó sự nhầm lẫn
Bạn xem và sửa giúp mình
Mình mô tả như trong file đính kèm
Cảm ơn bạn
 

File đính kèm

  • Copy of hàm tìm giá trị (22222222).xlsm
    17.1 KB · Đọc: 5
Upvote 0
nvh611 đã viết:
Cảm ơn bạn @HieuCD
Công thức trên chó sự nhầm lẫn
Bạn xem và sửa giúp mình
Mình mô tả như trong file đính kèm
Cảm ơn bạn
Nhấp chuột vào đây để mở rộng...
Mình cứ nghỉ kết quả đảo ngược
Chỉnh lại 1 chút
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range, Optional ByVal TypeCond As Boolean = True) As Variant
  'TypeCond=False: Xet dieu kien nguoc lai
  Dim blArr() As Boolean, Res As String, tmp, dk As Boolean
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""
 
  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If (InStr(1, VungDk(i, j).Value, tmp) = 0) = TypeCond Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i
 
  For j = 1 To sCol
    If blArr(j) = False Then
      If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j) '--------True;False
    End If
  Next j

  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
 
Upvote 0
HieuCD đã viết:
Mình cứ nghỉ kết quả đảo ngược
Chỉnh lại 1 chút
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range, Optional ByVal TypeCond As Boolean = True) As Variant
  'TypeCond=False: Xet dieu kien nguoc lai
  Dim blArr() As Boolean, Res As String, tmp, dk As Boolean
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""

  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If (InStr(1, VungDk(i, j).Value, tmp) = 0) = TypeCond Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i

  For j = 1 To sCol
    If blArr(j) = False Then
      If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j) '--------True;False
    End If
  Next j

  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
Nhấp chuột vào đây để mở rộng...
Mình cảm ơn bạn @HieuCD
Mình cũng nghĩ là bạn hiểu lầm thôi
Cảm ơn bạn rất nhiều!
 
Upvote 0
HieuCD đã viết:
Mình cứ nghỉ kết quả đảo ngược
Chỉnh lại 1 chút
Mã: 
Function JoinIfArr(ByVal VungDk As Range, ByVal DieuKien As Range, ByVal KetQua As Range, Optional ByVal TypeCond As Boolean = True) As Variant
  'TypeCond=False: Xet dieu kien nguoc lai
  Dim blArr() As Boolean, Res As String, tmp, dk As Boolean
  Dim i As Long, j As Byte, sRow As Long, sCol As Byte, k As Byte
  sRow = VungDk.Rows.Count
  sCol = VungDk.Columns.Count
  If DieuKien.Rows.Count <> sRow Or KetQua.Columns.Count <> sCol Then
    JoinIfArr = CVErr(xlErrRef): Exit Function
  End If
  JoinIfArr = ""

  If Len(DieuKien(sRow, 1).Value) = 0 Then Exit Function
  ReDim blArr(1 To sCol)
  For i = 1 To sRow
    tmp = DieuKien(i, 1).Value
    If Len(tmp) > 0 Then
      For j = 1 To sCol
        If blArr(j) = False Then
          If (InStr(1, VungDk(i, j).Value, tmp) = 0) = TypeCond Then
            k = k + 1: blArr(j) = True
          End If
        End If
      Next j
      If k = sCol Then Exit For
    End If
  Next i

  For j = 1 To sCol
    If blArr(j) = False Then
      If Len(Res) = 0 Then Res = KetQua(1, j) Else Res = Res & "-" & KetQua(1, j) '--------True;False
    End If
  Next j

  JoinIfArr = Res
  Set vDieuKien = Nothing: Set DieuKien = Nothing: Set KetQua = Nothing
End Function
Nhấp chuột vào đây để mở rộng...
Lại phiền bạn @HieuCD chút xíu nữa là trong công thức nếu có ô trống thì nó coi như dữ liệu khác nhau
Bạn giúp mình chỉnh lại nhé
Cảm ơn bạn
 

File đính kèm

  • hàm tìm giá trị (1) (1).xlsm
    17.9 KB · Đọc: 6
Upvote 0
nvh611 đã viết:
Lại phiền bạn @HieuCD chút xíu nữa là trong công thức nếu có ô trống thì nó coi như dữ liệu khác nhau
Bạn giúp mình chỉnh lại nhé
Cảm ơn bạn
Nhấp chuột vào đây để mở rộng...
Hàm Chỉ không xét cột điều kiện trống, còn vùng điều kiện trống vẫn xét mờ. Hay là bạn có ý khác? nhập tay kết quả gởi lên
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

A
Đếm dữ liệu với điều kiện
Trả lời
11
Đọc
86
DeTong
D
A
Excel thiếu dữ liệu
Trả lời
2
Đọc
49
Hoàng Tuấn 868
H
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
29
Đọc
2K
vu_tuan_manh_linh
vu_tuan_manh_linh
T
V/v tối ưu xử lý đoạn code
Trả lời
4
Đọc
150
huhumalu
H
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
16
Đọc
387
giaiphap
giaiphap
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom