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

Tranhoe · 30/6/13

Mình có 1 file Định mức 1172 (trong xây dựng) được chuyển đổi từ PDF sang XLS.
File này gồm hơn 100 Sheets có cấu trúc gần tương tự nhau, phần Dữ liệu cần xử lý chỉ nằm trên 1 Dòng (Row). Trong file mình chỉ trích ra 2 Sheet để làm ví dụ: Table 49 (Goc) và Table 50 (Goc) là dữ liệu gốc cần xử lý; còn Table 49 (Ket Qua) để đưa ra yeuu cầu về kết quả cần đạt được

Vấn đề ở đây là trong 1 ô có nhiều dòng cách nhau bằng dấu xuống dòng (Alt+Enter) và số dấu xuống dòng trong mỗi sheet không giống nhau. Mình cũng xem nhiều topic trong GPE và vận dụng Function tach(cell As Range, n As Byte) As String của anh Viethoai trong bài viết ở đây nhưng mình chỉ biết làm thủ công như trong file đính kèm, nếu làm cho hơn 100 Sheets thì quá khổ sở.

Mong các Bạn viết giúp Code VBA giải quyết vấn đề trên. Đồng thời giúp luôn lỗi không hiển thị đúng ký tự "ư".
File đính kèm:

TrungChinhs · 30/6/13

Tranhoe đã viết:
Mình có 1 file Định mức 1172 (trong xây dựng) được chuyển đổi từ PDF sang XLS.
File này gồm hơn 100 Sheets có cấu trúc gần tương tự nhau, phần Dữ liệu cần xử lý chỉ nằm trên 1 Dòng (Row). Trong file mình chỉ trích ra 1 Sheet để làm ví dụ: Table 49 (Goc) là dữ liệu gốc cần xử lý, Table 49 (Goc) là kết quả cần đạt được

Vấn đề ở đây là trong 1 ô có nhiều dòng cách nhau bằng dấu xuống dòng (Alt+Enter) và số dấu xuống dòng trong mỗi sheet không giống nhau. Mình cũng xem nhiều topic trong GPE và vận dụng Function tach(cell As Range, n As Byte) As String của anh Viethoai trong bài viết ở đây nhưng mình chỉ biết làm thủ công như trong file đính kèm, nếu làm cho hơn 100 Sheets thì quá khổ sở.

Mong các Bạn viết giúp Code VBA giải quyết vấn đề trên. Đồng thời giúp luôn lỗi không hiển thị đúng ký tự "ư".
File đính kèm:

1. Viết code mà nhìn thấy Font .Vn ngán luôn (chẳng lẽ phải viết thêm code tự chuyển font Unicode ?).

2. Dữ liệu nguồn ở các sheet nên thống nhất để ở cùng 1 dòng.

3. Kết quả bạn định để đâu ? (để ngay trên Tab...(Goc) hay phải thêm Tab...(ket qua))

4. Vụ chữ "ư" tôi nghĩ bạn làm thủ công được mà. Nếu nhiều sheet thì dùng VBA nhưng cũng phải đổi về Font Unicode.

Dữ liệu nguuồn tốt thì bạn sẽ nhanh nhận được kết quả (Tôi ngồi gần 2 tiếng với bài này rồi)

Mấy ý trên để code đỡ phức tạp không đáng có.

TrungChinhs · 30/6/13

Không thấy hồi âm của bạn Tranhoe Tôi làm tạm file này và để kết quả tại sheet gốc. Nếu muốn xoá dữ liệu nguồn thì xóa dấu nháy " ' " trong câu lệnh ' [a3:a10].EntireRow.Delete

Việc đổi Font sang Unicode và sửa chữ "ư" tôi làm thủ công.

Mã:

Sub Split_Char10()
    On Error Resume Next
    For Each sh In Worksheets
        With sh
            .[a10].Resize(, 8) = "   "
            For Each cls In .[a3].Resize(, 8)
                tmp = Split(cls, ChrW(10))
                For i = 0 To UBound(tmp)
                    If tmp(i) = "" Then tmp(i) = "-"
                    .Range(cls.Address)(50000).End(3)(2) = tmp(i)
                Next
            Next
            For Each cls In .[e11].Resize(20, 4)
                If cls.Value > 0 Then cls.Value = cls * 1
            Next
    '        [a3:a10].EntireRow.Delete
        End With
    Next
End Sub

Tranhoe · 30/6/13

TrungChinhs đã viết:
Không thấy hồi âm của bạn Tranhoe Tôi làm tạm file này và để kết quả tại sheet gốc. Nếu muốn xoá dữ liệu nguồn thì xóa dấu nháy " ' " trong câu lệnh ' [a3:a10].EntireRow.Delete

Cám ơn anh TrungChinhs nhiều. Đã đúng như ý.

Đúng như Anh nói, dữ liệu đưa lên chưa thống nhất phạm vi (số Dòng) của Tiêu đề Table là do file PDF gốc, mình sẽ tự chèn và sửa lại sau.
Code của Anh viết, mình thử dùng cho font TCVN3 cũng không ảnh hưởng.
Việc chuyển Font và sửa lỗi chữ "ư" sẽ làm tiếp.

Tranhoe · 30/6/13

TrungChinhs đã viết:
Không thấy hồi âm của bạn Tranhoe Tôi làm tạm file này và để kết quả tại sheet gốc.

Vẫn chưa được Anh à.
Giá trị trong ô từ Cột thứ 5 trở đi là gộp của nhiều giá trị số có cả phần thập phân nhưng khi Split ra thì mất hết dấu thập phân dẫn đến sai số từ 10 đến 10000 lần
Anh chỉnh giúp lại nhé. Cám ơn Anh nhiều.

TrungChinhs · 30/6/13

Tranhoe đã viết:
Vẫn chưa được Anh à.
Giá trị trong ô từ Cột thứ 5 trở đi là gộp của nhiều giá trị số có cả phần thập phân nhưng khi Split ra thì mất hết dấu thập phân dẫn đến sai số từ 10 đến 10000 lần
Anh chỉnh giúp lại nhé. Cám ơn Anh nhiều.

Không có chuyện ấy đâu, chẳng qua chỉ là hiển thị thôi, bạn cho hiện thêm số xem có thấy số lẻ không (nhấn nút <-0.00 trên thanh công cụ)

Tranhoe · 30/6/13

TrungChinhs đã viết:
Không có chuyện ấy đâu, chẳng qua chỉ là hiển thị thôi, bạn cho hiện thêm số xem có thấy số lẻ không (nhấn nút <-0.00 trên thanh công cụ)

Anh xem Table49. Vữa lót là 0,0155 m3, Split trở thành 155,00 m3 và .v.v.
Mình sửa 1 phần code như sau:

Mã:

            For Each cls In .[e11].Resize(20, 4)
               cls.Value = Replace(cls, ",", ".")
            Next

thì đúng được với các số <1, còn các số >1 vẫn bị sai. Anh nghiên cứu giúp.
Mình có việc nên phải Off rồi.

ndu96081631 · 30/6/13

TrungChinhs đã viết:
Không có chuyện ấy đâu, chẳng qua chỉ là hiển thị thôi, bạn cho hiện thêm số xem có thấy số lẻ không (nhấn nút <-0.00 trên thanh công cụ)

Có đấy anh à!
Chuổi "0,155" trên máy anh được hiểu là không phẩy một trăm năm mươi lăm... đó là vì control panel máy anh thiết lập dấu phẩy là dấu thập phân
Trên máy tính khác mà control panel thiết lập dấu chấm là dấu thập phân thì... sai bét
---------------------
Có 1 điều luôn mặc định: Trong VBA luôn xem dấu chấm là dấu thập phân, bất kể control panel thiết lập kiểu gì.
Vậy điều anh cần làm là:
- Không nên tính toán trực tiếp trên sheet mà nên chuyển mọi giá trị vào 1 array
- Replace dấu phẩy thành chấm trong VBA
- Tính toán trong VBA xong rồi hãy gán xuống sheet

dhn46 · 30/6/13

dhn46 đóng góp với topic 1 đoạn Code
1/ Code này kiểm tra xem cột thứ 3 xem có chữ "vật liệu" hay không sẽ tiến hành tách => phải chó chữ "vật liệu" tại cột 3
2/ Không cần quan tâm dòng của dữ liệu nguồn (chỉ cần chú ý tới cột)

Mã:

Sub Tach()
    Dim sh As Worksheet
    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
                            sh.Cells(rw + i + 4, col) = Replace(Replace(match, ChrW(10), ""), ",", Mid(1 / 2, 2, 1))
                        Next
                    End With
                Next
            Exit For
            End If
        Next
    Next
End Sub

TrungChinhs · 30/6/13

Tôi đã xem kỹ, Code không sai. Đây có thể là lỗi do Options trong máy của bạn ? Bạn thử làm như sau: Vào Menu Tools - Options - International - bỏ dấu kiểm tại ô Use system separators

hoặc thêm câu lệnh Application.UseSystemSeparators = False vào dòng đầu của code để máy tự làm

Nếu không được thì tôi cũng bó tay vì code trên không động chạm gì đến số liệu của bạn.

P/s vừa Post bài xong thì thấy bài của ndu ở bên trên. Tôi nghĩ ndu đã bắt đúng bệnh vì máy tôi đã đổi dấu phảy là số thập phân.

Tranhoe · 30/6/13

ndu96081631 đã viết:
Có đấy anh à!
Chuổi "0,155" trên máy anh được hiểu là không phẩy một trăm năm mươi lăm... đó là vì control panel máy anh thiết lập dấu phẩy là dấu thập phân
Trên máy tính khác mà control panel thiết lập dấu chấm là dấu thập phân thì... sai bét
---------------------
Có 1 điều luôn mặc định: Trong VBA luôn xem dấu chấm là dấu thập phân, bất kể control panel thiết lập kiểu gì.
Vậy điều anh cần làm là:
- Không nên tính toán trực tiếp trên sheet mà nên chuyển mọi giá trị vào 1 array
- Replace dấu phẩy thành chấm trong VBA
- Tính toán trong VBA xong rồi hãy gán xuống sheet

Sư phụ đã đọc mà không chịu ra tay tương trợ. Học trò chỉ "học lóm" đành bó tay

TrungChinhs · 30/6/13

Tranhoe đã viết:
Sư phụ đã đọc mà không chịu ra tay tương trợ. Học trò chỉ "học lóm" đành bó tay

Bạn làm được chưa ? Nếu chưa được thì vào Control panel đổi dấu chấm thành phảy và phẩy thành chấm rồi chạy code của tôi vẫn OK mà.

Tranhoe · 30/6/13

TrungChinhs đã viết:
Bạn làm được chưa ? Nếu chưa được thì vào Control panel đổi dấu chấm thành phảy và phẩy thành chấm rồi chạy code của tôi vẫn OK mà.

Vẫn còn lỗi.
Vào Table 50: Vậ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)

Tranhoe · 30/6/13

Vấn đề là ý kiến của Bác Ndu Anh ạ:

- Không nên tính toán trực tiếp trên sheet mà nên chuyển mọi giá trị vào 1 array
- Replace dấu phẩy thành chấm trong VBA
- Tính toán trong VBA xong rồi hãy gán xuống sheet

Tức là chỉ cần 1 vòng lặp For đầu tiên kết hợp với ý trên, nhưng mình không đủ sức.

TrungChinhs · 30/6/13

Tranhoe đã viết:
Vẫn còn lỗi.
Vào Table 50: Vậ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)

Bạn làm theo bài 10 chưa ?

Vấn đề là ý kiến của Bác Ndu Anh ạ:
- Không nên tính toán trực tiếp trên sheet mà nên chuyển mọi giá trị vào 1 array
- Replace dấu phẩy thành chấm trong VBA
- Tính toán trong VBA xong rồi hãy gán xuống sheet

Tức là chỉ cần 1 vòng lặp For đầu tiên kết hợp với ý trên, nhưng mình không đủ sức.

Không đơn giản thế đâu bạn ạ. Cái món array này tôi cũng còn non lắm nên chưa thử.

Tranhoe · 30/6/13

Đã làm theo bài 10#: Vừa đổi trong Control Panen vừa đổi trong Tool\Option của Excel
Đã thêm câu lệnh: Application.UseSystemSeparators = False vào Code.
Anh xem lại Table 50 sẽ thấy.

dhn46 · 30/6/13

Tranhoe đã viết:
Vấn đề là ý kiến của Bác Ndu Anh ạ:

- Không nên tính toán trực tiếp trên sheet mà nên chuyển mọi giá trị vào 1 array
- Replace dấu phẩy thành chấm trong VBA
- Tính toán trong VBA xong rồi hãy gán xuống sheet

Tức là chỉ cần 1 vòng lặp For đầu tiên kết hợp với ý trên, nhưng mình không đủ sức.

* Tính toán trên sheet cũng được nhưng phải chú ý:
- Dấu phân cách thập phân không bao giờ cố định là dấu chấm như VBA => giải pháp hãy lấy dấu phân cách của 1 phép chia thập phân (1/2 =>0.5 hay 0,5). Code của bác Trungchinhs nếu Replace theo hướng này thì đúng với mọi máy tính.
- Bài này đơn thuần chỉ là tách dữ liệu => đưa trực tiếp lên sheet tốc độ không giảm là bao
- Đưa trực tiếp lên sheet là con đường tiếp cận VBA dễ dàng hơn cho người mới tìm hiểu.
* Nếu đưa Array thì có thể làm theo hướng:
- Duyệt qua các cột
- Đặt i = 0 (vị trí dòng thứ 1 của mảng)
- Tiến hành tách và gán dữ liệu xuống các dòng tiếp theo (i=i+1)
- Đặt i = 0 và Next Cột
---------------------------------------------------------------------------------------------
Và điều cuối cùng: không biết Code tôi tham gia có giúp được chủ Topic giải quyết vấn đề không?

Tranhoe · 30/6/13

dhn46 đã viết:
dhn46 đóng góp với topic 1 đoạn Code
1/ Code này kiểm tra xem cột thứ 3 xem có chữ "vật liệu" hay không sẽ tiến hành tách => phải chó chữ "vật liệu" tại cột 3
2/ Không cần quan tâm dòng của dữ liệu nguồn (chỉ cần chú ý tới cột)

Mã:

Sub Tach() Dim sh As Worksheet 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 sh.Cells(rw + i + 4, col) = Replace(Replace(match, ChrW(10), ""), ",", Mid(1 / 2, 2, 1)) Next End With Next Exit For End If Next Next End Sub

Code của Bạn mình chạy không thấy kết quả. Bảng tính vẫn như cũ.

dhn46 · 30/6/13

Tranhoe đã viết:
Code của Bạn mình chạy không thấy kết quả. Bảng tính vẫn như cũ.

Bác thử lại file dhn46 đính kèm rồi phản hồi nhé.

Tranhoe · 30/6/13

dhn46 đã viết:
Bác thử lại file dhn46 đính kèm rồi phản hồi nhé.

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)

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

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

File đính kèm

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

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

File đính kèm

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

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

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

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

Huyền thoại GPE

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

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

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

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

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

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

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

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

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

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

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

File đính kèm

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

Facebook

Group