Tách dữ liệu từ một dãy (2 người xem)

Liên hệ QC

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

tv_X

Thành viên mới
Tham gia
1/11/07
Bài viết
21
Được thích
0
Chào các bác,

Hiện tại em đang phải xử lý dữ liệu, tuy nhiên có ca khó cần sự trợ giúp như sau:

1. Cột A có một dãy dữ liệu
Ví dụ: 1993: 1-12, 1994: 2-3,11-12, 1995: 1-12, 1996: 1-12, 1997: 1-12, 1998: 1-12 (thiếu 5,7)

2. Cột B mình cần tách các số của dãy (1-12, hoặc 1-12 (thiếu 5,7)... ra theo mẫu như sau:
1993(1,2,3,4,5,6,7,8,9,10,11,12), 1994(2,3,11,12),1995(1,2,3,4,5,6,7,8,9,10,11,12), 1996(1,2,3,4,5,6,7,8,9,10,11,12), 1997(1,2,3,4,5,6,7,8,9,10,11,12), 1998(1,2,3,4,6,8,9,10,11,12)

Cụ thể yêu cầy tại file đính kèm

Mong nhận được sự trợ giúp của các bác,

Cảm ơn nhiều.
 

File đính kèm

Chào các bác,

Hiện tại em đang phải xử lý dữ liệu, tuy nhiên có ca khó cần sự trợ giúp như sau:

1. Cột A có một dãy dữ liệu
Ví dụ: 1993: 1-12, 1994: 2-3,11-12, 1995: 1-12, 1996: 1-12, 1997: 1-12, 1998: 1-12 (thiếu 5,7)

2. Cột B mình cần tách các số của dãy (1-12, hoặc 1-12 (thiếu 5,7)... ra theo mẫu như sau:
1993(1,2,3,4,5,6,7,8,9,10,11,12), 1994(2,3,11,12),1995(1,2,3,4,5,6,7,8,9,10,11,12), 1996(1,2,3,4,5,6,7,8,9,10,11,12), 1997(1,2,3,4,5,6,7,8,9,10,11,12), 1998(1,2,3,4,6,8,9,10,11,12)

Cụ thể yêu cầy tại file đính kèm

Mong nhận được sự trợ giúp của các bác,

Cảm ơn nhiều.
Dùng thủ công:
  1. Nhấn Ctrl+H, hiện ra cửa sổ 'Find and Replace'
  2. Mục 'Find What' gõ: 1-12
  3. Mục 'Replace with' gõ: (1,2,3,4,5,6,7,8,9,10,11,12), xong nhấn nút 'Replace' phía dưới.
  4. Xóa bớt những số thừa.
Chúc bạn ngày vui.
 
Chào các bác,

Hiện tại em đang phải xử lý dữ liệu, tuy nhiên có ca khó cần sự trợ giúp như sau:

1. Cột A có một dãy dữ liệu
Ví dụ: 1993: 1-12, 1994: 2-3,11-12, 1995: 1-12, 1996: 1-12, 1997: 1-12, 1998: 1-12 (thiếu 5,7)

2. Cột B mình cần tách các số của dãy (1-12, hoặc 1-12 (thiếu 5,7)... ra theo mẫu như sau:
1993(1,2,3,4,5,6,7,8,9,10,11,12), 1994(2,3,11,12),1995(1,2,3,4,5,6,7,8,9,10,11,12), 1996(1,2,3,4,5,6,7,8,9,10,11,12), 1997(1,2,3,4,5,6,7,8,9,10,11,12), 1998(1,2,3,4,6,8,9,10,11,12)

Cụ thể yêu cầy tại file đính kèm

Mong nhận được sự trợ giúp của các bác,

Cảm ơn nhiều.
Nếu chỉ có một quy luật 1-12 thì là theo kiểu quocgiacan.
Còn nó không có quy luật nào cả thì cách tốt nhất là bạn lường trước các dạng có thể xảy ra rồi đưa lên một lần, bạn nên đưa dữ liệu thực với vài chục Cell để các thành viên xem và giúp giải pháp khác (còn không thì cứ phải đi hỏi riết).
 
Lần chỉnh sửa cuối:
Đúng là không theo quy luật cố định ạ,

Em gửi các bác thông tin một số đoạn khá điển hình (trong tổng số 10.000 dòng) em đang có.

Kính nhờ các bác ra tay giúp ạ,

Cảm ơn các bác nhiều,
 

File đính kèm

Đúng là không theo quy luật cố định ạ,

Em gửi các bác thông tin một số đoạn khá điển hình (trong tổng số 10.000 dòng) em đang có.

Kính nhờ các bác ra tay giúp ạ,

Cảm ơn các bác nhiều,
Bạn muốn mọi người làm cho 10.000 dòng mà có vài dòng kết quả mong muốn cũng không đưa lên.
 
Đúng là không theo quy luật cố định ạ,

Em gửi các bác thông tin một số đoạn khá điển hình (trong tổng số 10.000 dòng) em đang có.

Kính nhờ các bác ra tay giúp ạ,

Cảm ơn các bác nhiều,
Mã:
Sub tach()
Dim i As Long, str As String, str2 As String, arr, darr
arr = Range("A2:A" & [a65000].End(xlUp).Row)
ReDim darr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    str = Replace(Replace(arr(i, 1), ":", " "), " ", "|")
    With CreateObject("vbscript.regexp")
        .Global = True: .ignorecase = True
        .Pattern = "\d+-\d+"
        For Each Item In .Execute(str)
            str2 = Item
            str = Replace(str, "|" & str2, tach1(str2)): str = Replace(str, "," & str2, tach1(str2))
        Next
        darr(i, 1) = Replace(str, "|", " ")
    End With
Next
[b2].Resize(UBound(arr), 1) = darr
End Sub
Function tach1(str As String) As String
For i = CLng(Left(str, InStr(1, str, "-") - 1)) To CLng(Mid(str, InStr(1, str, "-") + 1, 4))
    tach1 = tach1 & IIf(tach1 = "", "", ",") & CStr(i)
Next
tach1 = "(" & tach1 & ")"
End Function
Cho bạn code này, chắc không đúng hết!!!
 
Mã:
Sub tach()
Dim i As Long, str As String, str2 As String, arr, darr
arr = Range("A2:A" & [a65000].End(xlUp).Row)
ReDim darr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
    str = Replace(Replace(arr(i, 1), ":", " "), " ", "|")
    With CreateObject("vbscript.regexp")
        .Global = True: .ignorecase = True
        .Pattern = "\d+-\d+"
        For Each Item In .Execute(str)
            str2 = Item
            str = Replace(str, "|" & str2, tach1(str2)): str = Replace(str, "," & str2, tach1(str2))
        Next
        darr(i, 1) = Replace(str, "|", " ")
    End With
Next
[b2].Resize(UBound(arr), 1) = darr
End Sub
Function tach1(str As String) As String
For i = CLng(Left(str, InStr(1, str, "-") - 1)) To CLng(Mid(str, InStr(1, str, "-") + 1, 4))
    tach1 = tach1 & IIf(tach1 = "", "", ",") & CStr(i)
Next
tach1 = "(" & tach1 & ")"
End Function
Cho bạn code này, chắc không đúng hết!!!
Bài nầy rất khó giải bằng regexp, Treo giải cho bạn 1 chầu cà fe. Khà khà khà
Chúc bạn 1 ngày vui
 
Bài nầy rất khó giải bằng regexp, Treo giải cho bạn 1 chầu cà fe. Khà khà khà
Chúc bạn 1 ngày vui
Chầu cafe này không uống được rồi, dữ liệu không đồng nhất với nhau, nên không xử lý hết được, chỉnh lại regexp chút:
Mã:
Sub tach()
Dim i As Long, j As Long, str As String, str2 As String, arr, darr
arr = Range("A2:A" & [a65000].End(xlUp).Row)
ReDim darr(1 To UBound(arr), 1 To 1)
With CreateObject("vbscript.regexp")
    For i = 1 To UBound(arr)
        str = arr(i, 1)
            .Global = True: .ignorecase = True
            .Pattern = "[,.:\s]+(\d+-\d+)"
            For Each Item In .Execute(str)
                j = 0
                str = Replace(str, Item.submatches(j), tach1(Item.submatches(j)))
                j = j + 1
            Next
            .Pattern = "),("
            darr(i, 1) = Replace(Replace(str, "),(", ","), ")(", ",")
    Next
End With
[b2].Resize(UBound(arr), 1) = darr
End Sub
Function tach1(str As String) As String
For i = CLng(Left(str, InStr(1, str, "-") - 1)) To CLng(Mid(str, InStr(1, str, "-") + 1, 4))
    tach1 = tach1 & IIf(tach1 = "", "", ",") & CStr(i)
Next
tach1 = "(" & tach1 & ")"
End Function
 
Chầu cafe này không uống được rồi, dữ liệu không đồng nhất với nhau, nên không xử lý hết được, chỉnh lại regexp chút:
Mã:
Sub tach()
Dim i As Long, j As Long, str As String, str2 As String, arr, darr
arr = Range("A2:A" & [a65000].End(xlUp).Row)
ReDim darr(1 To UBound(arr), 1 To 1)
With CreateObject("vbscript.regexp")
    For i = 1 To UBound(arr)
        str = arr(i, 1)
            .Global = True: .ignorecase = True
            .Pattern = "[,.:\s]+(\d+-\d+)"
            For Each Item In .Execute(str)
                j = 0
                str = Replace(str, Item.submatches(j), tach1(Item.submatches(j)))
                j = j + 1
            Next
            .Pattern = "),("
            darr(i, 1) = Replace(Replace(str, "),(", ","), ")(", ",")
    Next
End With
[b2].Resize(UBound(arr), 1) = darr
End Sub
Function tach1(str As String) As String
For i = CLng(Left(str, InStr(1, str, "-") - 1)) To CLng(Mid(str, InStr(1, str, "-") + 1, 4))
    tach1 = tach1 & IIf(tach1 = "", "", ",") & CStr(i)
Next
tach1 = "(" & tach1 & ")"
End Function
Chầu ca fe nầy hơi khó
 

File đính kèm

Chầu ca fe nầy hơi khó
Bài này còn nhiều kiểu dữ liệu bác ah, như bài #4 của tác giả có đưa ra hàng loạt loại chẳng có quy luật cũng chẳng có đáp án :p

Một số loại lung tung beng

1/ 2012: Vol: 57: 1-2, 2013Vol:58 1-2, 2011Vol 56 N.1-2, 2014: Vol 59: 1-2, 2015: Vol 60: 1
2/ 1920-1923: Số 1-17, 1924: Số 18-23, 1925: Số 24-29, 1926: Số 30-35, Số 1/01920, Số 35/1926
3/ Số 1/2012, 2011: Vol 13: 1, 2012:Vol 13: 2- Vol 14: 1, 2013: Vol 14: 2- Vol 15: 1, 2014: Vol 15: 2, 2015: Vol 16 N 2
4/ 1943: Số 1-17, Số 1/1943, Số 17/1943
 
Bài này còn nhiều kiểu dữ liệu bác ah, như bài #4 của tác giả có đưa ra hàng loạt loại chẳng có quy luật cũng chẳng có đáp án :p

Một số loại lung tung beng

1/ 2012: Vol: 57: 1-2, 2013Vol:58 1-2, 2011Vol 56 N.1-2, 2014: Vol 59: 1-2, 2015: Vol 60: 1
2/ 1920-1923: Số 1-17, 1924: Số 18-23, 1925: Số 24-29, 1926: Số 30-35, Số 1/01920, Số 35/1926
3/ Số 1/2012, 2011: Vol 13: 1, 2012:Vol 13: 2- Vol 14: 1, 2013: Vol 14: 2- Vol 15: 1, 2014: Vol 15: 2, 2015: Vol 16 N 2
4/ 1943: Số 1-17, Số 1/1943, Số 17/1943
Mình đùa vui với dòng đầu thôi, còn mấy cái sau không biết kết quả là gì nên không thể viết code được
Mấy dòng sau có lẽ tác giả muốn đùa với diễn đàn
 
Chầu ca fe nầy hơi khó
Chầu này thì chịu, pattern của regexp đã nhận được hết các trường hợp xx-xx rồi, nhưng vấn đề khi replace thì chạy kết quả không đúng như 1-12 thì 11-12 cũng bị replace luôn, sữa lại cũng được nhưng mấy dữ liệu còn lại chắc không làm được vì không có quy luật gì hết!!!
 
Chầu cafe này không uống được rồi, dữ liệu không đồng nhất với nhau, nên không xử lý hết được, chỉnh lại regexp chút:
Mã:
Sub tach()
Dim i As Long, j As Long, str As String, str2 As String, arr, darr
arr = Range("A2:A" & [a65000].End(xlUp).Row)
ReDim darr(1 To UBound(arr), 1 To 1)
With CreateObject("vbscript.regexp")
    For i = 1 To UBound(arr)
        str = arr(i, 1)
            .Global = True: .ignorecase = True
            .Pattern = "[,.:\s]+(\d+-\d+)"
            For Each Item In .Execute(str)
                j = 0
                str = Replace(str, Item.submatches(j), tach1(Item.submatches(j)))
                j = j + 1
            Next
            .Pattern = "),("
            darr(i, 1) = Replace(Replace(str, "),(", ","), ")(", ",")
    Next
End With
[b2].Resize(UBound(arr), 1) = darr
End Sub
Function tach1(str As String) As String
For i = CLng(Left(str, InStr(1, str, "-") - 1)) To CLng(Mid(str, InStr(1, str, "-") + 1, 4))
    tach1 = tach1 & IIf(tach1 = "", "", ",") & CStr(i)
Next
tach1 = "(" & tach1 & ")"
End Function


Cảm ơn các bác đã dành thời gian trợ giúp,

Trong điều kiện dữ liệu không có quy luật cố định (được nhập theo ngẫu hứng) thì code của bác excel_lv1.5 đã giúp được em giải quyết được yêu cầu cơ bản, còn các trường hợp còn lại em phải tự đồng bộ lại và xử lý thêm, tuy hơi mất công chút.

Một lần nữa xin chân thành cảm ơn các bác

tv_X
http://www.giaiphapexcel.com/diendan/members/excel_lv1-5.1130050/
 
Web KT

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

Back
Top Bottom