Làm rỏ hơn: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!
Cảm ơn bạn @HieuCD đã quan tâm: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
Cảm ơn bạn @Ba Tê công thức gần đúngKhô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.
Thấy dùng công thức cũng được: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!
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!
VBA làm gì có công thức, nên sửa lại tiêu đềXin công thức VBA
Tạo cho bạn Function với số cột tùy ý, xem cách dùng trong FileCả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.
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
Cảm ơn bạn @HieuCDTạ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
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)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 đỡ
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
Cảm ơn bạn @HieuCD công thức cũng đã rất đúngKhô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
Bạn xem giúp tôi nhé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
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ờ bạn chỉnh lại nghịch đảo của công thứcKhô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
Xem cách dùng Function trong FileNhờ bạn chỉnh lại nghịch đảo của công thức
Cảm ơn bạn @HieuCD
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
Cảm ơn bạn @HieuCDXem 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
Mình cứ nghỉ kết quả đảo ngượcCả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
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
Mình cảm ơn bạn @HieuCDMì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
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 nhauMì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
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2