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

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)

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) (1 người xem)

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

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

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

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

File đính kèm

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

Huyền thoại GPE

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

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

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

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

Thành viên gắn bó

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

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

Huyền thoại GPE

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

Huyền thoại GPE

Thời gian đếm ngược.