Thống kê có ký tự ghi bằng ký tự "từ"," đến" (Từ 1 đến 3, 8, từ 10 đến 12) (2 người xem)

Người dùng đang xem chủ đề này

kphat_369

Thành viên mới
Tham gia
17/8/09
Bài viết
6
Được thích
2
Các bạn vui lòng giúp tôi với!
Tôi có cột A từ A3 đến A10 là tên hàng (không liên tục) tương ứng là :name1, name2, name3, name8, name10, name11, name12, name15.
Tôi muốn có kết quả tại ô B3 là "Name1 ~ name3, name8, name10~name12, name15".
Vui lòng xem file excel đính kèm.
Rất cần sự giúp đỡ của các bạn.
Chân thành cảm ơn!
 

File đính kèm

Thử 3 đoạn code này xem nhé! Tôi viết theo dữ liệu bạn gửi lên.
Code này để xuất kết quả ra bảng tính :
PHP:
Sub XuatKetqua()
Dim i As Long, k As Long
Dim sArr(), dArr, arrKQ

sArr = Sheet1.Range("A3:A" & Sheet1.[A65536].End(xlUp).Row).Value
ReDim dArr(1 To UBound(sArr))
ReDim arrKQ(1 To UBound(sArr))

For i = 1 To UBound(sArr)
    k = k + 1
    dArr(k) = Val(Right(sArr(i, 1), Len(sArr(i, 1)) - 4))
Next
dArr = SortArr(dArr)
dArr = Connect(dArr)

For i = 1 To UBound(dArr)
    dArr(i) = "name" & dArr(i)
Next
Sheet1.Cells(1, 3) = Join(dArr, ", ")
End Sub

Code này để Sort mảng :
PHP:
Private Function SortArr(sArr)
Dim Arr
Dim i As Long
Dim j As Long
Dim Lb As Long
Dim n As Long
Dim Tempt
Arr = sArr
n = UBound(Arr)
Lb = LBound(Arr)
For i = Lb To n - 1
    For j = i + 1 To n
        If Arr(i) > Arr(j) Then
            Tempt = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Tempt
        End If
    Next j
Next i
SortArr = Arr
End Function
Code này để nối :
PHP:
Private Function Connect(rG)
Dim aR(), aTK(), aKQ()
Dim i As Long, uB As Long, be As Long
Dim k As Long
aR = rG
uB = UBound(aR)

be = aR(1): k = 0
For i = 1 To uB - 1
    If aR(i) + 1 < aR(i + 1) Then
     
        k = k + 1
        ReDim Preserve aTK(1 To k)
        aTK(k) = IIf(be = aR(i), Format(be, "00"), Format(be, "00") & "-" & Format(aR(i), "00"))
        be = aR(i + 1)
    End If
Next

k = k + 1
ReDim Preserve aTK(1 To k)
aTK(k) = IIf(be = aR(uB), Format(be, "00"), Format(be, "00") & "-" & Format(aR(uB), "00"))
Connect = aTK

End Function

Chi tiết xem file đính kèm.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Cho mình gửi lời xin lỗi đến bạn vì lời cảm ơn muộn này. Mấy hôm nay bận ngoài công trường nên không có dịp lên diễn đàn. Hôm nay cần sử dụng đến những đoạn code mà bạn gửi tặng. Cảm ơn bạn rất nhiều. Chúc bạn Sức khỏe!
hoamattroicoi
 
Upvote 0
Thật tuyệt vời Hoamattroicoi ạ. Bạn thật hay và bạn đã giúp tôi rất nhiều trong công việc.
Bạn có thể cho tôi xin 1 địa chỉ dùng để liên lạc bằng tin nhắn được không?
mail của mình là kphat369@gmail.com
 
Upvote 0

Bài viết mới nhất

Back
Top Bottom