Nối chuỗi nâng cao hàm VBA

[jusend]

Mình tìm được Hàm VBA dùng để nối dữ liệu hiện (visible, filtered) như bên dưới. Tuy nhiên, mình cần nâng cao hơn là chỉ nổi dữ liệu DUY NHẤT.

Function JoinVisibleText(xRg As Variant, sptChar As String)
Dim rg As Range
For Each rg In xRg
If (rg.EntireRow.Hidden = False) And (rg.EntireColumn.Hidden = False) Then
JoinVisibleText = JoinVisibleText & rg.Value & sptChar
End If
Next
JoinVisibleText = Left(JoinVisibleText, Len(JoinVisibleText) - Len(sptChar))
End Function

Ví dụ đính kèm nhờ các cao nhân sửa code chỉ điểm. Xin cảm ơn!

 

[snow25]

Mình tìm được Hàm VBA dùng để nối dữ liệu hiện (visible, filtered) như bên dưới. Tuy nhiên, mình cần nâng cao hơn là chỉ nổi dữ liệu DUY NHẤT.

Function JoinVisibleText(xRg As Variant, sptChar As String)
Dim rg As Range
For Each rg In xRg
If (rg.EntireRow.Hidden = False) And (rg.EntireColumn.Hidden = False) Then
JoinVisibleText = JoinVisibleText & rg.Value & sptChar
End If
Next
JoinVisibleText = Left(JoinVisibleText, Len(JoinVisibleText) - Len(sptChar))
End Function

Ví dụ đính kèm nhờ các cao nhân sửa code chỉ điểm. Xin cảm ơn!

Thử code.

Function JoinVisibleText(xRg As Variant, sptChar As String)
    Dim rg As Range
    For Each rg In xRg
        If (rg.EntireRow.Hidden = False) And (rg.EntireColumn.Hidden = False) Then
           If Not InStr(sptChar & JoinVisibleText & sptChar, sptChar & rg.Value & sptChar) And Len(rg.Value) Then
            JoinVisibleText = JoinVisibleText & rg.Value & sptChar
           End If
        End If
    Next
    JoinVisibleText = Left(JoinVisibleText, Len(JoinVisibleText) - Len(sptChar))
End Function

 

[bebo021999]

Dùng dictionary cho nhẹ code nhé :

Function JoinVisibleText(xRg As Range, sptChar As String)
Dim cell As Range, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For Each cell In xRg
    If Not dic.exists(cell.Value) And Not cell.EntireRow.Hidden And Not cell.EntireColumn.Hidden And Not IsEmpty(cell) Then
        dic.Add cell.Value, ""
    End If
Next
JoinVisibleText = Join(dic.keys, sptChar)
End Function

 

[jusend]

Dùng dictionary cho nhẹ code nhé :

Function JoinVisibleText(xRg As Range, sptChar As String)
Dim cell As Range, dic As Object
Set dic = CreateObject("Scripting.Dictionary")
For Each cell In xRg
    If Not dic.exists(cell.Value) And Not cell.EntireRow.Hidden And Not cell.EntireColumn.Hidden And Not IsEmpty(cell) Then
        dic.Add cell.Value, ""
    End If
Next
JoinVisibleText = Join(dic.keys, sptChar)
End Function

Tuyệt vời, cám ơn anh. Dùng code của anh thì tốc độ xử lý nhanh và số lượng dòng lớn (>30000) vẫn không bị lỗi #Value