code VBA có được không bạn?Mọi người giúp em với em đang cần gấp quá.
Mọi người giúp em với em đang cần gấp quá.
dùng cột phụ để tínhCác anh chị giúp dùm em có hàm nào nối dữ liệu của cột A theo điều kiện cột B với. Em cảm ơn mọi người.
p/s: theo file dữ liệu kèm theo.
Các anh chị giúp dùm em có hàm nào nối dữ liệu của cột A theo điều kiện cột B với. Em cảm ơn mọi người.
p/s: theo file dữ liệu kèm theo.
Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
Dim aTmp, arr(), Item, tmp As String
Dim i As Long, n As Long
'On Error Resume Next
For i = LBound(Arrays) To UBound(Arrays)
aTmp = Arrays(i)
If Not IsArray(aTmp) Then aTmp = Array(aTmp)
For Each Item In aTmp
If TypeName(Item) <> "Error" Then
tmp = CStr(Item)
n = n + 1
ReDim Preserve arr(1 To n)
arr(n) = tmp
End If
Next
Next
If n Then JoinText = Join(arr, Delimiter)
End Function
=IF(B2="","",JoinText(", ",OFFSET(A2,,,IFERROR(MATCH(FALSE,ISBLANK(B3:$B$14),0),1))))
Sub snst()
Dim tmp As Variant, r As Long, lr As Long, KQ() As String, T As String, i As Long, j As Long
tmp = Sheet1.Range("A2:B" & Sheet1.Range("A65000").End(xlUp).Row).Value
lr = UBound(tmp, 1)
ReDim KQ(1 To lr, 1 To 1)
For j = 1 To lr
If tmp(j, 2) <> "" Then
i = j
For r = j To lr - 1
T = T & tmp(r, 1) & ", "
If tmp(r + 1, 2) <> "" Then KQ(i, 1) = Left(T, Len(T) - 2): T = "": i = r + 1
Next r
Exit For
End If
Next j
If tmp(lr, 2) <> "" Then KQ(lr, 1) = tmp(lr, 1)
Sheet1.Range("D2").Resize(1000, 1).ClearContents
Sheet1.Range("D2").Resize(lr, 1).Value = KQ
End Sub
Function JoinDL(ByVal Delimiter As String, Rng1 As Range, Rng2 As Range) As String
If Rng2(1, 1).Value = "" Then Exit Function
Dim i As Integer
JoinDL = Rng1(1, 1)
For i = 2 To Rng1.Rows.Count
If Rng1(i, 1) <> "" And Rng2(i, 1) = "" Then
JoinDL = JoinDL & Delimiter & Rng1(i, 1)
Else
Exit Function
End If
Next
End Function
=JoinDL(", ",A2:$A$13,B2:$B$13)