Tách dữ liệu trong các cell (6 người xem)

xungdels001 · 3/10/14

Mong anh chị diễn đàn giúp đỡ em làm nút macro. để tách dữ liệu như trong ví dụ.
tách tù sheet nội dung tại cột B sang sheet kết quả tại các cột C D E. với số lượng bài tập phải chép.Cám ơn anh chj GPE

gtri · 3/10/14

xungdels001 đã viết:
Mong anh chị diễn đàn giúp đỡ em làm nút macro. để tách dữ liệu như trong ví dụ.
tách tù sheet nội dung tại cột B sang sheet kết quả tại các cột C D E. với số lượng bài tập phải chép.Cám ơn anh chj GPE

Nội dung của B2 cần làm rõ chỗ này : tại sheet Ketqua, cột Hoa, số bài 12 vì sao là 37(22+15)

xungdels001 · 3/10/14

Tại bài số 12 của hoa là 37 bài vì có số bài 12x22 lần và 121 23x15 lần. kết quả bài 12 sẽ là 37 lần vì 121 ở đây là bài 12 và bài 21 .Xin lỗi vì em viết chú thích 37(15+22). Thank

gtri · 4/10/14

xungdels001 đã viết:
Tại bài số 12 của hoa là 37 bài vì có số bài 12x22 lần và 121 23x15 lần. kết quả bài 12 sẽ là 37 lần vì 121 ở đây là bài 12 và bài 21 .Xin lỗi vì em viết chú thích 37(15+22). Thank

Chạy thử file đính kèm xem sao.
Viết cho 3 cái tên.
------------------------
File đính kèm chưa được ổn vì test quá ít dữ liệu.
Bạn sửa dòng code này sẽ cho kết quả chính xác.
Thay cái này

PHP:

For r=1 To Ubound(BaoCao)

Bằng cái này

PHP:

For r = (d - 1) * 25 + 1 To d * 25

Là ổn

xungdels001 · 5/10/14

Cám ơn anh vì code chạy rất tuyệt. Nhưng em có chút thay đổi là em chỉ viết bài 12 21 23 x 15thay vì 121 23x 15 sau đó lại có bài 101 x10 thì nó sẽ hiểu bài đó là 101 được không anh. Còn nữa khi trong ô B2 bảng dữ liệu có 2 Hoa thì nó chỉ lấy nội dung của Hoa thứ 2 mà không cộng thêm vào Hoa thứ nhất. Mong anh giúp em

xungdels001 · 5/10/14

Cám ơn anh vì code chạy rất tuyệt. Nhưng em có chút thay đổi là em chỉ viết bài 12 21 23 x 15thay vì 121 23x 15 sau đó lại có bài 101 x10 thì nó sẽ hiểu bài đó là 101 được không anh. Còn nữa khi trong ô B2 bảng dữ liệu có 2 Hoa thì nó chỉ lấy nội dung của Hoa thứ 2 mà không cộng thêm vào Hoa thứ nhất. Mong anh giúp em

gtri · 5/10/14

xungdels001 đã viết:
Cám ơn anh vì code chạy rất tuyệt. Nhưng em có chút thay đổi là em chỉ viết bài 12 21 23 x 15thay vì 121 23x 15 sau đó lại có bài 101 x10 thì nó sẽ hiểu bài đó là 101 được không anh. Còn nữa khi trong ô B2 bảng dữ liệu có 2 Hoa thì nó chỉ lấy nội dung của Hoa thứ 2 mà không cộng thêm vào Hoa thứ nhất. Mong anh giúp em

Có lẽ là nội dung của bạn cần có quy ước nhất định
- Số bài lớn nhất của mỗi dòng tương ứng là 101, tức là mỗi ô của sheet NoiDung sẽ trả về 101 dòng tại sheet Ketqua
- Tên phải gõ đầy đủ, không dấu. VD Tòan--->Toan,Hòa--->Hoa. Nếu viết tắt thì khó nhận diện
-------------
Bạn đặt các nội dung yêu cầu đầy đủ để giải quyết 1 lần cho đỡ.

xungdels001 · 5/10/14

Cám ơn anh. Trong file của em có quy định tên ngưòi không dấu, số bài thì có thể rất lớn có thể lên đến hàng nghìn bài

gtri · 5/10/14

xungdels001 đã viết:
Cám ơn anh. Trong file của em có quy định tên ngưòi không dấu, số bài thì có thể rất lớn có thể lên đến hàng nghìn bài

Tức là số thứ tự bài của mỗi cá nhân trong 1 ô NoiDung là không cố định?
Nếu số bài là không xác định sẽ phải sửa lại hoàn toàn code đã có.

xungdels001 · 5/10/14

gtri đã viết:
Tức là số thứ tự bài của mỗi cá nhân trong 1 ô NoiDung là không cố định?
Nếu số bài là không xác định sẽ phải sửa lại hoàn toàn code đã có.

Vâng số thứ tự bài của mội cá nhân là không xác định. Đồng thời có thể xuất hiện cá nhân đó 2 đến 3 lần trong 1ô nội dung. Cám ơn anh

gtri · 6/10/14

xungdels001 đã viết:
Vâng số thứ tự bài của mội cá nhân là không xác định. Đồng thời có thể xuất hiện cá nhân đó 2 đến 3 lần trong 1ô nội dung. Cám ơn anh

xungdels001 đã viết:
Cám ơn anh vì code chạy rất tuyệt. Nhưng em có chút thay đổi là em chỉ viết bài 12 21 23 x 15thay vì 121 23x 15 sau đó lại có bài 101 x10 thì nó sẽ hiểu bài đó là 101 được không anh. Còn nữa khi trong ô B2 bảng dữ liệu có 2 Hoa thì nó chỉ lấy nội dung của Hoa thứ 2 mà không cộng thêm vào Hoa thứ nhất. Mong anh giúp em

Kết quả mẫu trong bài của bạn có lẽ chưa đúng.
Gửi bạn đoạn code cùng file đính kèm, bạn kiểm tra lại xem sao
Yêu cầu giá trị "x" và số kế tiếp phải liền nhau.VD x15 là đúng, x 15 là không tính được

PHP:

Public Sub TachPhucTap()
Dim DL, SoBai(), Ptu, Tam(), BaoCao(), Nhom, Thay, d As Long, r As Long, c As Long, cl As Long
Sheet2.Range("A2", Sheet2.Range("E65000")).ClearContents
DL = Sheet1.Range("B2", Sheet1.Range("B65000").End(xlUp))
ReDim SoBai(1 To UBound(DL))

With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
For d = 1 To UBound(DL)
ReDim Tam(1 To Len(DL(d, 1)))
.Pattern = "[a-z]+"
For c = 0 To .Execute(DL(d, 1)).Count - 1
Tam(.Execute(DL(d, 1))(c).FirstIndex + 1) = .Execute(DL(d, 1))(c)
Next c

.Pattern = "[x]\d+"
For c = 0 To .Execute(DL(d, 1)).Count - 1
Tam(.Execute(DL(d, 1))(c).FirstIndex + 1) = "x" & Right(1000000 + Right(.Execute(DL(d, 1))(c), Len(.Execute(DL(d, 1))(c)) - 1) * 1, 6)
Next c

.Pattern = "\d+"
For c = 0 To .Execute(DL(d, 1)).Count - 1
Tam(.Execute(DL(d, 1))(c).FirstIndex + 1) = Right(1000000 + .Execute(DL(d, 1))(c) * 1, 6)
Next c

DL(d, 1) = Join(Tam, " ")
.Pattern = "[x](\d+)\s\1"
DL(d, 1) = Trim(.Replace(DL(d, 1), "x" & "$1"))
Next d

.Pattern = "[a-z]+[^a-z]+"
ReDim Tam(1 To UBound(DL), 1 To 3)
For d = 1 To UBound(DL)
DL(d, 1) = Replace(UCase(DL(d, 1)), "X", "*")
For c = 1 To 3
For cl = 1 To 3
If InStr(1, .Execute(DL(d, 1))(cl - 1), UCase(Sheet2.Cells(1, 2 + c)), 1) Then
Tam(d, c) = .Execute(DL(d, 1))(cl - 1)
End If
Next cl
Tam(d, c) = Replace(Tam(d, c), "*", "x")
Next c
Next d

For d = 1 To UBound(SoBai)
For c = 1 To 3
If Tam(d, c) <> "" Then
.Pattern = "[x]\d+"
Thay = .Replace(Tam(d, c), " ")
.Pattern = "\d+"
For cl = 0 To .Execute(Thay).Count - 1
If SoBai(d) < Val(.Execute(Thay)(cl)) Then
SoBai(d) = Val(.Execute(Thay)(cl))
End If
Next cl
End If
Next c
Ptu = Ptu + SoBai(d)
Next d
ReDim BaoCao(1 To Ptu, 1 To 4)

.Pattern = "[x]\d+"
Ptu = 0
For d = 1 To UBound(Tam)
For c = 2 To 4
Set Nhom = .Execute(Tam(d, c - 1))
Tam(d, c - 1) = .Replace(Tam(d, c - 1), "#")
Thay = Split(Tam(d, c - 1), "#")
For r = 1 To SoBai(d)
For cl = 0 To Nhom.Count - 1
BaoCao(r + Ptu, 1) = r
If InStr(1, Thay(cl), Right(1000000 + r, 6), 1) Then
BaoCao(r + Ptu, c) = BaoCao(r + Ptu, c) + Right(Nhom(cl), Len(Nhom(cl)) - 1) * 1
End If
Next cl
Next r
Next c
Ptu = Ptu + SoBai(d)
Next d

End With
Sheet2.Range("B2").Resize(Ptu, 4).Value = BaoCao
Sheet2.Range("A2", "A" & Ptu + 1) = "=row()-1"

End Sub

------------
Viết cho 3 cái tên

xungdels001 · 6/10/14

anh xem lại giúp nếu trong 1 ô nội dung Hoa xuất hiện 2 lần thì sẽ lấy tổng cả 2 lần đó. Code hiện tại chỉ lấy nội dung của Hoa lần thứ 2 xuất hiện> cám ơn anh

gtri · 6/10/14

Bạn muốn cộng 2 lần Hoa

xungdels001 đã viết:
anh xem lại giúp nếu trong 1 ô nội dung Hoa xuất hiện 2 lần thì sẽ lấy tổng cả 2 lần đó. Code hiện tại chỉ lấy nội dung của Hoa lần thứ 2 xuất hiện> cám ơn anh

Nhưng bài #5 bạn yêu cầu như thế này

xungdels001 đã viết:
Nhưng em có chút thay đổi là em chỉ viết bài 12 21 23 x 15thay vì 121 23x 15 sau đó lại có bài 101 x10 thì nó sẽ hiểu bài đó là 101 được không anh. Còn nữa khi trong ô B2 bảng dữ liệu có 2 Hoa thì nó chỉ lấy nội dung của Hoa thứ 2 mà không cộng thêm vào Hoa thứ nhất. Mong anh giúp em

Vậy cuối cùng là lấy theo bài nào?

xungdels001 · 6/10/14

ý em là nếu có 2 Hoa xuất hiện thì lấy cả 2 cộng vào với nhau. Xin lỗi vì em nói không rõ ý. cám ơn anh

gtri · 6/10/14

xungdels001 đã viết:
ý em là nếu có 2 Hoa xuất hiện thì lấy cả 2 cộng vào với nhau. Xin lỗi vì em nói không rõ ý. cám ơn anh

vậy yêu cầu cụ thể la thế nào:
-Bao nhiêu người.
-Cộng dồn hay thế nào
Bạn nêu yêu cầu 1 lần đầy đủ để giải quyết cho gọn

xungdels001 · 6/10/14

gtri đã viết:
vậy yêu cầu cụ thể la thế nào:
-Bao nhiêu người.
-Cộng dồn hay thế nào
Bạn nêu yêu cầu 1 lần đầy đủ để giải quyết cho gọn[/QUOT
số người nhiều nhất chỉ có 3 người. nhưng có thể 1 người xuất hiện 2 lần trong 1 ô nội dung nên cộng dồn cả 2 lần đó vào 1 ạ

gtri · 6/10/14

xungdels001 đã viết:
số người nhiều nhất chỉ có 3 người. nhưng có thể 1 người xuất hiện 2 lần trong 1 ô nội dung nên cộng dồn cả 2 lần đó vào 1 ạ

Bạn dán code này vào rồi kiểm tra với số mẫu lớn hơn xem sao

PHP:

Public Sub TachPhucTap()
Dim DL, SoBai(), Ptu, Tam(), BaoCao(), Nhom, Thay, d As Long, r As Long, c As Long, cl As Long
Sheet2.Range("A2", Sheet2.Range("E65000")).ClearContents
DL = Sheet1.Range("B2", Sheet1.Range("B65000").End(xlUp))
ReDim SoBai(1 To UBound(DL))

With CreateObject("VBScript.RegExp")
.Global = True
.IgnoreCase = True
For d = 1 To UBound(DL)
ReDim Tam(1 To Len(DL(d, 1)))
.Pattern = "[a-z]+"
For c = 0 To .Execute(DL(d, 1)).Count - 1
Tam(.Execute(DL(d, 1))(c).FirstIndex + 1) = .Execute(DL(d, 1))(c)
Next c

.Pattern = "[x]\d+"
For c = 0 To .Execute(DL(d, 1)).Count - 1
Tam(.Execute(DL(d, 1))(c).FirstIndex + 1) = "x" & Right(1000000 + Right(.Execute(DL(d, 1))(c), Len(.Execute(DL(d, 1))(c)) - 1) * 1, 6)
Next c

.Pattern = "\d+"
For c = 0 To .Execute(DL(d, 1)).Count - 1
Tam(.Execute(DL(d, 1))(c).FirstIndex + 1) = Right(1000000 + .Execute(DL(d, 1))(c) * 1, 6)
Next c

DL(d, 1) = Join(Tam, " ")
.Pattern = "[x](\d+)\s\1"
DL(d, 1) = Trim(.Replace(DL(d, 1), "x" & "$1"))
Next d

.Pattern = "[a-z]+[^a-z]+"
ReDim Tam(1 To UBound(DL), 1 To 3)
For d = 1 To UBound(DL)
DL(d, 1) = Replace(UCase(DL(d, 1)), "X", "*")
For c = 1 To 3
For cl = 1 To 3
If InStr(1, .Execute(DL(d, 1))(cl - 1), UCase(Sheet2.Cells(1, 2 + c)), 1) Then
Tam(d, c) = Tam(d, c) & " " & .Execute(DL(d, 1))(cl - 1) 'Dòng thay đổi để cộng dồn cùng tên
End If
Next cl
Tam(d, c) = Replace(Tam(d, c), "*", "x")
Next c
Next d

For d = 1 To UBound(SoBai)
For c = 1 To 3
If Tam(d, c) <> "" Then
.Pattern = "[x]\d+"
Thay = .Replace(Tam(d, c), " ")
.Pattern = "\d+"
For cl = 0 To .Execute(Thay).Count - 1
If SoBai(d) < Val(.Execute(Thay)(cl)) Then
SoBai(d) = Val(.Execute(Thay)(cl))
End If
Next cl
End If
Next c
Ptu = Ptu + SoBai(d)
Next d
ReDim BaoCao(1 To Ptu, 1 To 4)

.Pattern = "[x]\d+"
Ptu = 0
For d = 1 To UBound(Tam)
For c = 2 To 4
Set Nhom = .Execute(Tam(d, c - 1))
Tam(d, c - 1) = .Replace(Tam(d, c - 1), "#")
Thay = Split(Tam(d, c - 1), "#")
For r = 1 To SoBai(d)
For cl = 0 To Nhom.Count - 1
BaoCao(r + Ptu, 1) = r
If InStr(1, Thay(cl), Right(1000000 + r, 6), 1) Then
BaoCao(r + Ptu, c) = BaoCao(r + Ptu, c) + Right(Nhom(cl), Len(Nhom(cl)) - 1) * 1
End If
Next cl
Next r
Next c
Ptu = Ptu + SoBai(d)
Next d

End With
Sheet2.Range("B2").Resize(Ptu, 4).Value = BaoCao
Sheet2.Range("A2", "A" & Ptu + 1) = "=row()-1"

End Sub

-------------
Lưu ý là gõ tên đầy đủ không dấu. Trong VD bạn có nhập tên H ( Viết tắt ) là sẽ không tìm được số liệu

xungdels001 · 6/10/14

Cám ơn anh. Code thật tuyệt vời. Một lần nữa chân thành cám ơn anh

xungdels001 · 7/10/14

có 1 vấn đề nhỏ sau khi đọc code của anh tuy em không hiểu nó vận dụng ra sao nhưng em thấy thêm 1 dòng
"On Error Resume Next"
sau khi khai báo biến thì thấy chạy nuột hơn ko bị dính lỗi nữa.
Nếu có thời gian dảnh nhờ anh chỉ giúp em code này nó ý nghĩa của từng dòng nhé. Em muốn tiến bộ trong VBA mà em lại đang chập chững học. Cám ơn anh gtri }}}}}

gtri · 7/10/14

xungdels001 đã viết:
có 1 vấn đề nhỏ sau khi đọc code của anh tuy em không hiểu nó vận dụng ra sao nhưng em thấy thêm 1 dòng
"On Error Resume Next"
sau khi khai báo biến thì thấy chạy nuột hơn ko bị dính lỗi nữa.
Nếu có thời gian dảnh nhờ anh chỉ giúp em code này nó ý nghĩa của từng dòng nhé. Em muốn tiến bộ trong VBA mà em lại đang chập chững học.

Bạn không gửi file nên cũng không biết là lỗi gì nhưng chỉ cần kiểm tra kết quả chính xác là được.
Việc giải thích từng dòng lệnh có lẽ là hơi lâu, bạn có thể tìm kiếm trên diễn đàn có rất nhiều ví dụ sẽ dễ hiểu hơn.
Thân chào!

Tách dữ liệu trong các cell (6 người xem)

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

Thành viên mới

File đính kèm

Thành viên tích cực

Thành viên mới

Thành viên tích cực

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thành viên tích cực

Thành viên mới

Thành viên tích cực

Thành viên mới

Thành viên tích cực

File đính kèm

Thành viên mới

File đính kèm

Thành viên tích cực

Thành viên mới

Thành viên tích cực

Thành viên mới

Thành viên tích cực

Thành viên mới

Thành viên mới

Thành viên tích cực

Đếm ngược thời gian