Hàm nối dữ liệu cách cột

[nvh611]

Nhờ các bạn viết giúp hàm như file đính kèm
Trân thành cảm ơn các bạn

 

[Nhất Chi Lan]

Nhờ các bạn viết giúp hàm như file đính kèm
Trân thành cảm ơn các bạn

Bạn thử xem:

Function JoinTextColor(ByVal Delimiter As String, ByVal SourceRange As Range, _
        ByVal xlRange As Range, Optional ByVal xltext) As String
    Dim arr(), Item As Range, Str As String
    Dim n As Long
If IsMissing(xltext) Then xltext = ""
For Each Item In SourceRange
    If TypeName(Item) <> "Error" Then
        If Item.Interior.Color = xlRange.Interior.Color Then
            If Item = Empty Then Str = xltext Else Str = Item.Value
            If Len(Str) Then
                n = n + 1
                ReDim Preserve arr(1 To n)
                arr(n) = Str
            End If
        End If
    End If
Next
If n Then JoinTextColor = Join(arr, Delimiter)
End Function

 

[leonguyenz]

Tham khảo thêm code dưới.

Function GpeCcn(Delm As String, Dist As Byte, Rng As Range, Optional repK As String)
Dim i As Long, aTmp(), j As Long
If Rng.Count <= Dist Then Exit Function
ReDim aTmp(1 To Int(Rng.Count / (Dist + 1)) + 1)
For i = 1 To Rng.Count Step Dist + 1
    j = j + 1: aTmp(j) = IIf(Rng(i) <> "", Rng(i), repK)
Next i
If j Then GpeCcn = Join(aTmp, Delm)
End Function

Cú pháp: =GpeCcn("|",2,F5:AE6,"k")

 

[leonguyenz]

Tham khảo thêm code dưới.

Function GpeCcn(Delm As String, Dist As Byte, Rng As Range, Optional repK As String)
Dim i As Long, aTmp(), j As Long
If Rng.Count <= Dist Then Exit Function
ReDim aTmp(1 To Int(Rng.Count / (Dist + 1)) + 1)
For i = 1 To Rng.Count Step Dist + 1
    j = j + 1: aTmp(j) = IIf(Rng(i) <> "", Rng(i), repK)
Next i
If j Then GpeCcn = Join(aTmp, Delm)
End Function

Cú pháp: =GpeCcn("|",2,F5:AE6,"k")

Bạn sử dụng code dưới:

Function GpeCcn2(Delm As String, Dist As Byte, Rng As Range, Optional repK As String)
Dim i As Long, Tmp As String
If Rng.Count <= Dist Then Exit Function
For i = 1 To Rng.Count Step Dist + 1
    Tmp = Tmp & Delm & IIf(Rng(i) <> "", Rng(i), repK)
Next i
If Len(Tmp) Then GpeCcn2 = Right(Tmp, Len(Tmp) - 1)
End Function

 

[nvh611]

Bạn thử xem:

Function JoinTextColor(ByVal Delimiter As String, ByVal SourceRange As Range, _
        ByVal xlRange As Range, Optional ByVal xltext) As String
    Dim arr(), Item As Range, Str As String
    Dim n As Long
If IsMissing(xltext) Then xltext = ""
For Each Item In SourceRange
    If TypeName(Item) <> "Error" Then
        If Item.Interior.Color = xlRange.Interior.Color Then
            If Item = Empty Then Str = xltext Else Str = Item.Value
            If Len(Str) Then
                n = n + 1
                ReDim Preserve arr(1 To n)
                arr(n) = Str
            End If
        End If
    End If
Next
If n Then JoinTextColor = Join(arr, Delimiter)
End Function

Cảm ơn bạn @Nhất Chi Lan hàm rất tuyệt vời và cảm ơn bạn @leonguyenz đã nhiệt tình giúp đỡ
Chúc các bạn cuối tuần có nhiều niềm vui nhé!