Giúp tách Dữ liệu trong nhiều ô có chứa dấu xuống dòng (Alt+Enter)

dhn46 · 30/6/13

Tranhoe đã viết:
Code chạy tốt nhưng vẫn lỗi ở Table 50Vật liệu là 1,030 nhưng kết quả là 1.030 (một nghìn không trăm ba mươi)

Vậy quy luật ở đây là gì khi dữ liệu đầu vào không chuẩn xác?
Với:
0,48 => 0.48 => Ok
1,0 => 1 => Ok
16,62 => 16.62 => Ok
1,030 => 1.030 => NG mà lại là 1030
Liệu có phải chỉ riêng dòng Vật liệu thì không có dấu thập phân? Mà nếu có thì sẽ như thế nào: ví dụ một nghìn không trăm ba mươi phẩy năm mươi sáu - 1030.56)
Vậy bác có thể cho 1 quy luật để chạy Code không? (Nếu thay dấu "," thành dấu thập phân sẽ không đảm bảo.)
Code trong file và code post bài trước là 1)

Tranhoe · 30/6/13

Dữ liệu là chuẩn dhn46 ạ.
Mình thử lại với Table 51 cũng lỗi như thế

dhn46 · 1/7/13

Tranhoe đã viết:
Dữ liệu là chuẩn dhn46 ạ.
Mình thử lại với Table 51 cũng lỗi như thế
View attachment 104905

Dạ, ý DHN là: dữ liệu không đồng nhất dấu thập phân và dấu phân cách hàng ngàn
Với các số liệu nhỏ hơn 1 thì không vấn đề nhưng nếu lớn hơn 1 thí sẽ ra sao?
Cách hiểu với số liệu 16,67 khác với 1,030
Vậy lấy quy luật gì để chuyển đổi. Bác làm trong ngành nên sẽ tường tận hơn quy luật nay.

ndu96081631 · 1/7/13

dhn46 đã viết:
Vậy quy luật ở đây là gì khi dữ liệu đầu vào không chuẩn xác?
Với:
0,48 => 0.48 => Ok
1,0 => 1 => Ok
16,62 => 16.62 => Ok
1,030 => 1.030 => NG mà lại là 1030
Liệu có phải chỉ riêng dòng Vật liệu thì không có dấu thập phân? Mà nếu có thì sẽ như thế nào: ví dụ một nghìn không trăm ba mươi phẩy năm mươi sáu - 1030.56)
Vậy bác có thể cho 1 quy luật để chạy Code không? (Nếu thay dấu "," thành dấu thập phân sẽ không đảm bảo.)
Code trong file và code post bài trước là 1)

Tóm lại: Nếu Control Panel của người ta thiết lập DẤU PHẨY là DẤU THẬP PHÂN thì code của bạn sẽ cho kết quả sai
-----------------------
Mấy vụ chuyển text thành giá trị này tốt nhất nên thí nghiệm thật kỹ (nhất là các giá trị Number, Date...):
- Thiết lập Control Panel theo kiểu Mỹ ---> Chạy code
- Thiết lập Control Panel theo kiểu VN ---> Chạy code
Nếu code chạy đúng với cả 2 kiểu thiết lập thì OK
-----------------------
Tôi vẫn giữ quan điểm: Cho các giá trị vào array, tính toán trong đó xong rồi hẳn gán xuống sheet (như vậy bạn khỏi phải quan tâm đến các thiết lập trong Control Panel)

Tranhoe · 1/7/13

Mình sửa code của Bạn 1 tí thì kết quả hoàn toàn chính xác
tự code:

Mã:

sh.Cells(rw + i + 4, col) = Replace(Replace(match, ChrW(10), ""), ",", Mid(1 / 2, 2, 1))

sửa thành:

Mã:

sh.Cells(rw + i + 4, col) = Replace(Replace(match, ChrW(10), ""), ",", ".")

Đó là về giải thuật.
Tuy vậy, trong định mức xây dựng thì có công việc không sử dụng vật liệu. Ví dụ như đào đất bằng máy thì chỉ có nhân công và máy thi công thôi. Nên căn cứ vào tiêu chí "Vật liệu" để tách sẽ không mang tính tổng quát được.

Cách tốt nhất là thống nhất mẫu CSDL (như TrungChinhs đã làm) có dữ liệu nằm ở Hàng thứ 3 và có thể có đến 10 cột.
Bạn có thể hiệu chỉnh Code theo hướng này không?

dhn46 · 1/7/13

Vậy thì dùng Array vậy

Mã:

Sub Tach()
    Dim sh As Worksheet, Arr(1 To 100, 1 To 8)
    Dim col As Long, rw As Long
    For Each sh In ThisWorkbook.Worksheets
        For rw = 1 To 10
            If InStr(1, sh.Cells(rw, 3), "VËt liÖu") Then
                For col = 1 To 8
                    i = 0
                    With CreateObject("VbScript.Regexp")
                        .Global = True
                        .Pattern = ".*" & ChrW(10)
                        For Each match In .Execute(sh.Cells(rw, col) & Chr(10))
                            i = i + 1
                            Arr(i, col) = Replace(Replace(match, ChrW(10), ""), ",", ".")
                        Next
                    End With
                    sh.[A8].Resize(i, 8) = Arr
                Next
            Exit For
            End If
        Next
    Next
End Sub

Quay quay hoài mà không up file được, bác chịu khó copy code nhé.

Tranhoe · 1/7/13

Chạy tốt rồi DHN46 ạ.
Tuy vậy, trong định mức xây dựng thì có công việc không sử dụng vật liệu. Ví dụ như đào đất bằng máy thì chỉ có nhân công và máy thi công thôi. Nên căn cứ vào tiêu chí "Vật liệu" để tách sẽ không mang tính tổng quát được.

Cách tốt nhất là thống nhất mẫu CSDL (như TrungChinhs đã làm) có dữ liệu nằm ở Hàng thứ 3 (Giống Table 50 hoặc Table 51) và có thể có đến 10 cột.
Bạn có thể hiệu chỉnh Code theo hướng này không?

dhn46 · 1/7/13

Tranhoe đã viết:
Chạy tốt rồi DHN46 ạ.
Tuy vậy, trong định mức xây dựng thì có công việc không sử dụng vật liệu. Ví dụ như đào đất bằng máy thì chỉ có nhân công và máy thi công thôi. Nên căn cứ vào tiêu chí "Vật liệu" để tách sẽ không mang tính tổng quát được.

Cách tốt nhất là thống nhất mẫu CSDL (như TrungChinhs đã làm) có dữ liệu nằm ở Hàng thứ 3 (Giống Table 50 hoặc Table 51) và có thể có đến 10 cột.
Bạn có thể hiệu chỉnh Code theo hướng này không?

- Bác dùng Code sau. DHN46 đã ghi chú các phần mà bác có thể tùy biến như: số cột, dòng chứa dữ liệu.
- Nếu bác chuẩn được số dòng chứa CSDL thì code sẽ chạy tốt nếu không sẽ phải lựa chọn các phương thức bắt lỗi như các bài trên.

Mã:

Sub Tach()
    Dim sh As Worksheet, Arr(1 To 100, 1 To 10)    ' To 10 la so cot, thay doi so cot theo y muon
    Dim col As Long, rw As Long
    rw = 3                        'Dong chua du lieu
    For Each sh In ThisWorkbook.Worksheets
        For col = 1 To UBound(Arr, 2)
            i = 0
            With CreateObject("VbScript.Regexp")
                .Global = True
                .Pattern = ".*" & ChrW(10)
                For Each match In .Execute(sh.Cells(rw, col) & Chr(10))
                    i = i + 1
                    Arr(i, col) = Replace(Replace(match, ChrW(10), ""), ",", ".")
                Next
            End With
            sh.[A8].Resize(i, 8) = Arr     'Vi tri Paste ket qua
        Next
    Next
End Sub

Chúc bác hoàn thành File dữ liệu của mình!

Tranhoe · 1/7/13

Đã giải quyết được câu hỏi

Trên cơ sở Code của DHN46 mình sửa lại theo hướng thống nhất CSDL như trên, kết quả thật mỹ mãn

Mã:

Sub Tach_L2()
    Dim sh As Worksheet, Arr(1 To 100, 1 To 8)
    Dim col As Long, rw As Long
    For Each sh In ThisWorkbook.Worksheets
        'For rw = 1 To 10
        rw = 3
            'If InStr(1, sh.Cells(rw, 3), "VËt liÖu") Then
                For col = 1 To 8
                    i = 0
                    With CreateObject("VbScript.Regexp")
                        .Global = True
                        .Pattern = ".*" & ChrW(10)
                        For Each match In .Execute(sh.Cells(rw, col) & Chr(10))
                            i = i + 1
                            Arr(i, col) = Replace(Replace(match, ChrW(10), ""), ",", ".")
                        Next
                    End With
                    sh.[A8].Resize(i, 8) = Arr
                Next
            'Exit For
            'End If
        'Next
    Next
End Sub

Chân thành cám ơn Ndu, Dhn46 và TrungChinhs đã giúp đỡ.

PS: Vùa đăng bài xong thì Ndh46 đã trả lời rồi. Sẽ hoàn chỉnh code theo bài trên.
Chân thành cám ơn tất cả.

Tranhoe · 1/7/13

Code hoàn chỉnh

Code hoàn chỉnh như sau:

Mã:

Sub TachDuLieu()
    Dim sh As Worksheet, Arr(1 To 100, 1 To 100)
    Dim col As Long, rw As Long, n As Integer
    rw = 3                        'Dong chua du lieu
    For Each sh In ThisWorkbook.Worksheets
        n = [A3].End(xlToRight).Column  'So Cot chua du lieu
        For col = 1 To UBound(Arr, 2)
            i = 0
            With CreateObject("VbScript.Regexp")
                .Global = True
                .Pattern = ".*" & ChrW(10)
                For Each Match In .Execute(sh.Cells(rw, col) & Chr(10))
                    i = i + 1
                    Arr(i, col) = Replace(Replace(Match, ChrW(10), ""), ",", ".")
                Next
            End With
            sh.[A8].Resize(i, n) = Arr     'Vi tri Paste ket qua
        Next
    Next
End Sub

Như vậy đã được chưa nhỉ.

siwtom · 1/7/13

dhn46 đã viết:
- Bác dùng Code sau. DHN46 đã ghi chú các phần mà bác có thể tùy biến như: số cột, dòng chứa dữ liệu.
- Nếu bác chuẩn được số dòng chứa CSDL thì code sẽ chạy tốt nếu không sẽ phải lựa chọn các phương thức bắt lỗi như các bài trên.

Mã:

Sub Tach() Dim sh As Worksheet, Arr(1 To 100, 1 To 10) ' To 10 la so cot, thay doi so cot theo y muon Dim col As Long, rw As Long rw = 3 'Dong chua du lieu For Each sh In ThisWorkbook.Worksheets For col = 1 To UBound(Arr, 2) i = 0 With CreateObject("VbScript.Regexp") .Global = True .Pattern = ".*" & ChrW(10) For Each match In .Execute(sh.Cells(rw, col) & Chr(10)) i = i + 1 Arr(i, col) = Replace(Replace(match, ChrW(10), ""), ",", ".") Next End With sh.[A8].Resize(i, 8) = Arr 'Vi tri Paste ket qua Next Next End Sub

Chúc bác hoàn thành File dữ liệu của mình!

Tôi không bàn tới cách giải cho bạn Tranhoe vì đã có bạn dhn46 ra tay rồi.
Tôi chỉ muốn ý kiến với bạn dhn46 một tí.
Tôi không bàn tới chuyện đúng hay sai trong code của dhn46. Tôi chỉ muốn sửa một chút về đoạn dùng RegExp.

Vì chả lý gì đã dùng RegExp để tìm kiếm rồi sau khi tìm được lại phải Replace Chr(10) thành "". Nếu có thể thì tìm "ra luôn", không thao tác gì thêm nữa. Tức thay

Mã:

Replace(Match, ChrW(10), "")

bằng

Mã:

Match

Để làm được như thế thì ta sửa các thuộc tính của RegExp. Và cũng chả thêm Chr(10) vào cuối mỗi chuỗi làm gì. Cụ thể tôi sẽ sửa như sau, chỗ đỏ đỏ là thêm hoặc sửa

Mã:

Sub Tach()
    Dim sh As Worksheet, Arr(1 To 100, 1 To 10)    ' To 10 la so cot, thay doi so cot theo y muon
    Dim col As Long, rw As Long
    rw = 3                        'Dong chua du lieu
    For Each sh In ThisWorkbook.Worksheets
        For col = 1 To UBound(Arr, 2)
            i = 0
            With CreateObject("VbScript.Regexp")
                .Global = True
                [B][COLOR=#ff0000].MultiLine = True[/COLOR][/B]
                .Pattern = [B][COLOR=#ff0000]"^.*$"[/COLOR][/B]
                For Each Match In .Execute(sh.Cells(rw, col))
                    i = i + 1
                    Arr(i, col) = Replace([B][COLOR=#ff0000]Match[/COLOR][/B], ",", ".")
                Next
            End With
            sh.[A8].Resize(i, 8) = Arr     'Vi tri Paste ket qua
        Next
    Next
End Sub
-----------------
Tất nhiên tôi chỉ nhìn code rồi phán là sẽ lấy Pattern như thế. Ai quan tâm thì thử chạy code xem có đúng không.

Tất nhiên đây chỉ là ý kiến thảo luận thôi chứ tôi không nói Pattern của [COLOR=#0000ff][B]dhn46[/B][/COLOR] là sai.

Tranhoe · 1/7/13

Đã chạy thử Code của siwtom. Kết quả cũng hoàn toàn đúng

Mình chỉ biết chạy thử thôi. Còn nhìn Code thấy rất khó, nhất là cái vụ CreateObject("VbScript.Regexp") và các tham số của nó.
Phải học hỏi thôi.
Hoc, học nữa, học mãi vẫn không thấy bờ.

Tranhoe · 2/7/13

Có lẽ Code như trên là tối ưu rồi!
Từ hôm qua đến giờ không có ý kiến gì thêm nữa.

ndu96081631 · 3/7/13

Tranhoe đã viết:
Có lẽ Code như trên là tối ưu rồi!
Từ hôm qua đến giờ không có ý kiến gì thêm nữa.

Cái đó chưa chắc
Nói chung, nếu là dân yêu thích lập trình thì đừng bao giờ tự hài lòng với những gì đã làm được
It nhất nếu tôi viết code cho yêu cầu này thì có thể sẽ làm khác một chút:
- Tôi sẽ không gom chung mọi thứ vào 1 Sub
- Tôi sẽ tạo 1 hàm chuyên dùng để tách những cell chứa ký tự vbLf ra thành từng cell riêng
- Tiếp theo là 1 Sub riêng có ứng dụng hàm vừa viết ở trên
------------------------------------
Nói tóm lại: Cái gì mình nghi ngờ mai này có thể ứng dụng tiếp vào những bài toán khác thì nên viết riêng thành 1 Sub có tham số truyền hoặc 1 Function ---> Cái đó gọi là "đồ nghề" ---> Mai này cần cứ việc lấy ra xài khỏi cần viết lại
Đó là câu tôi trả lời chung cho thắc mắc của nhiều bạn: Tại sao ndu viết code (trả lời bài) nhanh đến vậy? Bời vì tôi luôn dùng những "đồ nghề" có sẵn chứ hiếm khi phải viết lại (mà dù có viết lại cũng là chỉnh sửa đôi chút những "đồ nghề" có sẵn)
Ẹc... Ẹc...

Tranhoe · 3/7/13

A ha! Kế "khích tướng" có tác dụng.
Sư phụ chịu lộ diện rồi. Tạo hàm chuyên dụng là nghề của Sư phụ mà.
Lại học thêm ít chiêu nữa. Cám ơn Sư phụ nhé!

ndu96081631 · 3/7/13

Tranhoe đã viết:
A ha! Kế "khích tướng" có tác dụng.
Sư phụ chịu lộ diện rồi. Tạo hàm chuyên dụng là nghề của Sư phụ mà.
Lại học thêm ít chiêu nữa. Cám ơn Sư phụ nhé!

Cũng chẳng khó khăn gì!
Các bạn đã viết Sub được thì việc tách ra để tạo 1 Function là chuyện trong tầm tay
Tự nghiên cứu xem (chẳng cần VBScript.RegExp cũng làm được)

Giúp tách Dữ liệu trong nhiều ô có chứa dấu xuống dòng (Alt+Enter)

dhn46

Hướng tới tương lai

Tranhoe

Thành viên hoạt động

File đính kèm

dhn46

Hướng tới tương lai

ndu96081631

Huyền thoại GPE

Tranhoe

Thành viên hoạt động

dhn46

Hướng tới tương lai

File đính kèm

Tranhoe

Thành viên hoạt động

dhn46

Hướng tới tương lai

Tranhoe

Thành viên hoạt động

Tranhoe

Thành viên hoạt động

siwtom

Thành viên gắn bó

Tranhoe

Thành viên hoạt động

Tranhoe

Thành viên hoạt động

ndu96081631

Huyền thoại GPE

Tranhoe

Thành viên hoạt động

ndu96081631

Huyền thoại GPE

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

Facebook

Group

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng