Phân tích dữ liệu chuỗi thành 4 cột riêng biệt - Anh chị giúp đỡ (1 người xem)

[htgiangdt]

Chào anh chị, em nhờ anh chị giúp em đề bài sau:
Phân tích chuỗi "Cột gốc" chia vào 4 cột B,C,D,E.
Em có danh mục của 4 cột B,C,D,E

Cám ơn anh chị
Email: giang.ht3@gmail.com

Ví dụ:

[TABLE="class: grid, width: 800"]
[TR]
[TD]Cột gốc[/TD]
[TD]Năm ban hành[/TD]
[TD]Cơ quan ban hành[/TD]
[TD]Lĩnh vực[/TD]
[TD]Loại văn bản[/TD]
[/TR]
[TR]
[TD]nam-ban-hanh~2013:2013,co-quan-ban-hanh~bo-ke-hoach-va-dau-tu:Bộ Kế hoạch và Đầu tư,co-quan-ban-hanh~bo-tai-chinh:Bộ Tài chính,co-quan-ban-hanh~bo-tai-nguyen-va-moi-truong:Bộ Tài nguyên và Môi trường,linh-vuc~tai-chinh:Tài chính,linh-vuc~tai-nguyen-va-moi-truong:Tài nguyên và Môi trường,loai-van-ban~thong-tu-lien-tich:Thông tư liên tịch[/TD]
[TD]2013[/TD]
[TD]Bộ Kế hoạch và đầu tư
Bộ Tài chính
Bộ Tài nguyên và Môi trường[/TD]
[TD]Tài chính
Tài nguyên và môi trường[/TD]
[TD]Thông tư liên tịch[/TD]
[/TR]
[TR]
[TD]co-quan-ban-hanh~bo-giao-duc-va-dao-tao:Bộ Giáo dục và Đào tạo,co-quan-ban-hanh~bo-tai-chinh:Bộ Tài chính,linh-vuc~giao-duc-va-dao-tao:Giáo dục và đào tạo,loai-van-ban~thong-tu-lien-tich:Thông tư liên tịch[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[/TR]
[TR]
[TD]nam-ban-hanh~2015:2015,co-quan-ban-hanh~bo-lao-dong-thuong-binh-va-xa-hoi:Bộ Lao động - Thương binh và Xã hội,linh-vuc~lao-dong-thuong-binh-xa-hoi:Lao động- Thương binh- Xã hội,linh-vuc~tai-chinh:Tài chính,loai-van-ban~thong-tu:Thông tư[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[/TR]
[/TABLE]

 

[gtri]

Chào anh chị, em nhờ anh chị giúp em đề bài sau:
Phân tích chuỗi "Cột gốc" chia vào 4 cột B,C,D,E.
Em có danh mục của 4 cột B,C,D,E

Cám ơn anh chị
Email: giang.ht3@gmail.com

Ví dụ:

[TABLE="class: grid, width: 800"]
[TR]
[TD]Cột gốc[/TD]
[TD]Năm ban hành[/TD]
[TD]Cơ quan ban hành[/TD]
[TD]Lĩnh vực[/TD]
[TD]Loại văn bản[/TD]
[/TR]
[TR]
[TD]nam-ban-hanh~2013:2013,co-quan-ban-hanh~bo-ke-hoach-va-dau-tu:Bộ Kế hoạch và Đầu tư,co-quan-ban-hanh~bo-tai-chinh:Bộ Tài chính,co-quan-ban-hanh~bo-tai-nguyen-va-moi-truong:Bộ Tài nguyên và Môi trường,linh-vuc~tai-chinh:Tài chính,linh-vuc~tai-nguyen-va-moi-truong:Tài nguyên và Môi trường,loai-van-ban~thong-tu-lien-tich:Thông tư liên tịch[/TD]
[TD]2013[/TD]
[TD]Bộ Kế hoạch và đầu tư
Bộ Tài chính
Bộ Tài nguyên và Môi trường[/TD]
[TD]Tài chính
Tài nguyên và môi trường[/TD]
[TD]Thông tư liên tịch[/TD]
[/TR]
[TR]
[TD]co-quan-ban-hanh~bo-giao-duc-va-dao-tao:Bộ Giáo dục và Đào tạo,co-quan-ban-hanh~bo-tai-chinh:Bộ Tài chính,linh-vuc~giao-duc-va-dao-tao:Giáo dục và đào tạo,loai-van-ban~thong-tu-lien-tich:Thông tư liên tịch[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[/TR]
[TR]
[TD]nam-ban-hanh~2015:2015,co-quan-ban-hanh~bo-lao-dong-thuong-binh-va-xa-hoi:Bộ Lao động - Thương binh và Xã hội,linh-vuc~lao-dong-thuong-binh-xa-hoi:Lao động- Thương binh- Xã hội,linh-vuc~tai-chinh:Tài chính,loai-van-ban~thong-tu:Thông tư[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[TD]?[/TD]
[/TR]
[/TABLE]

Dùng thử đoạn code này xem sao

Public Sub Tach_Chuoi()
Dim DL, kq(), Tam, r As Long, c As Long

DL = Sheet1.Range("A5:A7")
ReDim kq(1 To UBound(DL), 1 To 4)

For r = 1 To UBound(DL)
Tam = Split(DL(r, 1), ",")
For c = 0 To UBound(Tam)
If InStr(1, Tam(c), "nam-ban-hanh", 1) Then
kq(r, 1) = kq(r, 1) & Chr(10) & Split(Tam(c), ":")(1)
Else
If InStr(1, Tam(c), "co-quan-ban-hanh", 1) Then
kq(r, 2) = kq(r, 2) & Chr(10) & Split(Tam(c), ":")(1)
Else
If InStr(1, Tam(c), "linh-vuc", 1) Then
kq(r, 3) = kq(r, 3) & Chr(10) & Split(Tam(c), ":")(1)
Else
kq(r, 4) = kq(r, 4) & Chr(10) & Split(Tam(c), ":")(1)
End If
End If
End If
Next c
Next r

Sheet1.Range("G5").Resize(UBound(kq), 4).Value = kq
Sheet1.Range("G5").CurrentRegion.WrapText = True

End Sub

 

[VetMini]

Cái này dùng RegEx rất hữu hiệu.
Bạn nào muốn thử dợt nghề thì đây là cơ hội tốt.

 

[VetMini]

Chả ai hưởng ứng cả?
Thử trước xem ai có kiểu nào hay hơn hôn.

Function TimDuLieu(ByVal s As String, ByVal cde As String, Optional dlm As String = ",") As String
[COLOR=#008000]' hàm lấy chuỗi dữ liệu ứng theo loại trong một chuỗi khác
[/COLOR]Dim matches As Variant, match As Variant
Static rx As Object [COLOR=#008000]' tránh tạo object nhiều lần nếu hàm được gọi đi gọi lại nhiều lần[/COLOR]
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.Global = True
rx.Ignorecase = True
End If
TimDuLieu = ""
[COLOR=#008000]' phải dùng capture và submatch vì VBScirpt RegEx không có chuyện lookbehind - đáng tiếc!
[/COLOR]rx.Pattern = cde & "~[^,]+:([^,]+)"
If rx.test(s) Then
    Set matches = rx.Execute(s)
    For Each match In matches
    TimDuLieu = TimDuLieu & IIf(Len(TimDuLieu) > 0, dlm, "") & match.submatches(0)
    Next match
End If
End Function

Sub t()
[COLOR=#008000]' sub dùng để test hàm trên
' nếu dùng thì chỉnh code lấy số hàng trong cột A
[/COLOR]Dim c
For Each c In [a2:a6]
c.Offset(, 1) = TimDuLieu(c, "nam-ban-hanh", Chr(10))
c.Offset(, 2) = TimDuLieu(c, "co-quan-ban-hanh", Chr(10))
c.Offset(, 3) = TimDuLieu(c, "linh-vuc", Chr(10))
c.Offset(, 4) = TimDuLieu(c, "loai-van-ban", Chr(10))
Next c
End Sub

 

[gtri]

Chả ai hưởng ứng cả?
Thử trước xem ai có kiểu nào hay hơn hôn.

Function TimDuLieu(ByVal s As String, ByVal cde As String, Optional dlm As String = ",") As String
[COLOR=#008000]' hàm lấy chuỗi dữ liệu ứng theo loại trong một chuỗi khác
[/COLOR]Dim matches As Variant, match As Variant
Static rx As Object [COLOR=#008000]' tránh tạo object nhiều lần nếu hàm được gọi đi gọi lại nhiều lần[/COLOR]
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.Global = True
rx.Ignorecase = True
End If
TimDuLieu = ""
[COLOR=#008000]' phải dùng capture và submatch vì VBScirpt RegEx không có chuyện lookbehind - đáng tiếc!
[/COLOR]rx.Pattern = cde & "~[^,]+:([^,]+)"
If rx.test(s) Then
    Set matches = rx.Execute(s)
    For Each match In matches
    TimDuLieu = TimDuLieu & IIf(Len(TimDuLieu) > 0, dlm, "") & match.submatches(0)
    Next match
End If
End Function

Sub t()
[COLOR=#008000]' sub dùng để test hàm trên
' nếu dùng thì chỉnh code lấy số hàng trong cột A
[/COLOR]Dim c
For Each c In [a2:a6]
c.Offset(, 1) = TimDuLieu(c, "nam-ban-hanh", Chr(10))
c.Offset(, 2) = TimDuLieu(c, "co-quan-ban-hanh", Chr(10))
c.Offset(, 3) = TimDuLieu(c, "linh-vuc", Chr(10))
c.Offset(, 4) = TimDuLieu(c, "loai-van-ban", Chr(10))
Next c
End Sub

Bó tay, quả là tìm không ra cách gọn hơn.
Thank!

 

[htgiangdt]

Cám ơn anh/chị VetMini và gtri đã giải đáp cho em ^^ Em đang dùng thử.
Chúc hai anh/chị vui khỏe

 

[Ba Tê]

Chả ai hưởng ứng cả?
Thử trước xem ai có kiểu nào hay hơn hôn.

Function TimDuLieu(ByVal s As String, ByVal cde As String, Optional dlm As String = ",") As String
[COLOR=#008000]' hàm lấy chuỗi dữ liệu ứng theo loại trong một chuỗi khác
[/COLOR]Dim matches As Variant, match As Variant
Static rx As Object [COLOR=#008000]' tránh tạo object nhiều lần nếu hàm được gọi đi gọi lại nhiều lần[/COLOR]
If rx Is Nothing Then
Set rx = CreateObject("VBScript.RegExp")
rx.Global = True
rx.Ignorecase = True
End If
TimDuLieu = ""
[COLOR=#008000]' phải dùng capture và submatch vì VBScirpt RegEx không có chuyện lookbehind - đáng tiếc!
[/COLOR]rx.Pattern = cde & "~[^,]+:([^,]+)"
If rx.test(s) Then
    Set matches = rx.Execute(s)
    For Each match In matches
    TimDuLieu = TimDuLieu & IIf(Len(TimDuLieu) > 0, dlm, "") & match.submatches(0)
    Next match
End If
End Function

Sub t()
[COLOR=#008000]' sub dùng để test hàm trên
' nếu dùng thì chỉnh code lấy số hàng trong cột A
[/COLOR]Dim c
For Each c In [a2:a6]
c.Offset(, 1) = TimDuLieu(c, "nam-ban-hanh", Chr(10))
c.Offset(, 2) = TimDuLieu(c, "co-quan-ban-hanh", Chr(10))
c.Offset(, 3) = TimDuLieu(c, "linh-vuc", Chr(10))
c.Offset(, 4) = TimDuLieu(c, "loai-van-ban", Chr(10))
Next c
End Sub

Hưởng ứng 1 Function, có tiêu đề phụ.

Public Function GPE(Rng As Range, DK As Range) As String
Dim Tem, J As Long
Tem = Split(Rng, ",")
For J = 0 To UBound(Tem)
    If Tem(J) Like DK & "*" Then
        GPE = GPE & Mid(Tem(J), InStr(Tem(J), ":") + 1, 1000) & ", "
    End If
Next J
If Len(GPE) Then GPE = Left(GPE, Len(GPE) - 2)
End Function