Xâu chuỗi ký tự (1 người xem)

[quangdiepctmbk]

Trước đây mình có nhờ các bạn trên diễn đàn làm phần xâu chuỗi ký tự và loại bỏ số 0, nhưng do dữ liệu có sự thay đổi nên mình có mong muốn bổ sung ở khung màu vàng.
Các bạn xem và giúp mình nhé.

 

[huuthang_bd]

Trước đây mình có nhờ các bạn trên diễn đàn làm phần xâu chuỗi ký tự và loại bỏ số 0, nhưng do dữ liệu có sự thay đổi nên mình có mong muốn bổ sung ở khung màu vàng.
Các bạn xem và giúp mình nhé.

Bạn thử hàm này:

Function NoiChuoi(ByVal Rng As Range, ByVal C As String) As String
Dim Arr, i As Long, j As Long
If Rng.Count = 1 Then
    ReDim Arr(1 To 1, 1 To 1)
    Arr(1, 1) = Rng.Value
Else
    Arr = Rng.Value
End If
For i = 1 To UBound(Arr, 2)
    For j = 1 To UBound(Arr, 1)
        If Arr(j, i) <> "" Then NoiChuoi = NoiChuoi & C & Arr(j, i)
    Next
Next
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(" & C & "|-)0+"
    NoiChuoi = .Replace(NoiChuoi, "$1")
End With
NoiChuoi = Replace(NoiChuoi, C, "", 1, 1)
End Function

Với công thức:

=NoiChuoi(B3:B9,";")

 

[quangdiepctmbk]

Bạn thử hàm này:

Function NoiChuoi(ByVal Rng As Range, ByVal C As String) As String
Dim Arr, i As Long, j As Long
If Rng.Count = 1 Then
    ReDim Arr(1 To 1, 1 To 1)
    Arr(1, 1) = Rng.Value
Else
    Arr = Rng.Value
End If
For i = 1 To UBound(Arr, 2)
    For j = 1 To UBound(Arr, 1)
        If Arr(j, i) <> "" Then NoiChuoi = NoiChuoi & C & Arr(j, i)
    Next
Next
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(" & C & "|-)0+"
    NoiChuoi = .Replace(NoiChuoi, "$1")
End With
NoiChuoi = Replace(NoiChuoi, C, "", 1, 1)
End Function

Với công thức:

=NoiChuoi(B3:B9,";")

Mình đánh 0005-0010 nó không thành 5-10 bạn ah. Bạn xem lại giúp mình hoặc bạn gửi file bạn đã làm cho mình.
Cảm ơn bạn nhé.

 

[huuthang_bd]

Mình đánh 0005-0010 nó không thành 5-10 bạn ah. Bạn xem lại giúp mình hoặc bạn gửi file bạn đã làm cho mình.
Cảm ơn bạn nhé.

Bạn thử lại với code mới đi, tôi có sửa lại code do lúc đầu không thấy dạng 0005-0010 trong dữ liệu.

 

[quangdiepctmbk]

Cảm ơn bạn nhiều nhé!

 

[quangdiepctmbk]

Bạn cho mình hỏi thêm vấn đề nữa là nếu dữ liệu gốc ở một cell có dạng xuống dòng 005;
006
Có cách nào để khi gộp lại nó không xuống dòng nữa không?

 

[huuthang_bd]

Bạn cho mình hỏi thêm vấn đề nữa là nếu dữ liệu gốc ở một cell có dạng xuống dòng 005;
006
Có cách nào để khi gộp lại nó không xuống dòng nữa không?

Bạn thử sửa lại như thế này

Function NoiChuoi(ByVal Rng As Range, ByVal C As String) As String
Dim Arr, i As Long, j As Long
If Rng.Count = 1 Then
    ReDim Arr(1 To 1, 1 To 1)
    Arr(1, 1) = Rng.Value
Else
    Arr = Rng.Value
End If
For i = 1 To UBound(Arr, 2)
    For j = 1 To UBound(Arr, 1)
        If Arr(j, i) <> "" Then NoiChuoi = NoiChuoi & C & Arr(j, i)
    Next
Next
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(" & C & "|-)0+"
    NoiChuoi = .Replace(NoiChuoi, "$1")
End With
NoiChuoi = Replace(Replace(NoiChuoi, C, "", 1, 1), ChrW(10), "")
End Function

 

[quangdiepctmbk]

Bạn thử sửa lại như thế này

Function NoiChuoi(ByVal Rng As Range, ByVal C As String) As String
Dim Arr, i As Long, j As Long
If Rng.Count = 1 Then
    ReDim Arr(1 To 1, 1 To 1)
    Arr(1, 1) = Rng.Value
Else
    Arr = Rng.Value
End If
For i = 1 To UBound(Arr, 2)
    For j = 1 To UBound(Arr, 1)
        If Arr(j, i) <> "" Then NoiChuoi = NoiChuoi & C & Arr(j, i)
    Next
Next
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(" & C & "|-)0+"
    NoiChuoi = .Replace(NoiChuoi, "$1")
End With
NoiChuoi = Replace(Replace(NoiChuoi, C, "", 1, 1), ChrW(10), "")
End Function

Mình đã cho vào file nhưng kết quả lại là 5;006 nó không xuống dòng nữa nhưng lại không bỏ số 0 ở đầu.
Bạn xem lại giúp mình nhé.
Làm phiền bạn nhiều quá.

 

[huuthang_bd]

Mình đã cho vào file nhưng kết quả lại là 5;006 nó không xuống dòng nữa nhưng lại không bỏ số 0 ở đầu.
Bạn xem lại giúp mình nhé.
Làm phiền bạn nhiều quá.

À, tôi quên mất vụ này. Bạn thử code sau.

Function NoiChuoi(ByVal Rng As Range, ByVal C As String) As String
Dim Arr, i As Long, j As Long
If Rng.Count = 1 Then
    ReDim Arr(1 To 1, 1 To 1)
    Arr(1, 1) = Rng.Value
Else
    Arr = Rng.Value
End If
For i = 1 To UBound(Arr, 2)
    For j = 1 To UBound(Arr, 1)
        If Arr(j, i) <> "" Then NoiChuoi = NoiChuoi & C & Arr(j, i)
    Next
Next
NoiChuoi = Replace(NoiChuoi, ChrW(10), "")
With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(" & C & "|-)0+"
    NoiChuoi = .Replace(NoiChuoi, "$1")
End With
NoiChuoi = Replace(NoiChuoi, C, "", 1, 1)
End Function