Lọc dữ liệu từ file Text? (3 người xem)
- Thread starter minhquand
- Ngày gửi
Người dùng đang xem chủ đề này
Mình không rành về VBA nên nhờ các bác viết giùm.Từ từ cũng phải học thôi.
Upvote
0
Nó so sánh cột thứ 1 và thứ 2 bắt đầu từ hàng thứ 9 bên file TEXT với cột A và B bắt đầu từ hàng 16 nếu giống nhau nó sẽ lọc dữ liệu cột thứ 6 trong file TEXT vào cột D và E bên file excel.Cột 6 bên file TEXT nó sẽ lấy giá trị sau chữ C vào cột D sau chữ X vào cột E file excel dòng đầu tiên,dòng thứ 2 thì ngược lại,sau C vào E,sau X vào D...Trong file excel cột D và E là giá trị sau khi LỌC bác ạ.Thanks.
Upvote
0
1. Tôi viết qua, viết nhanh, không suy ngẫm để xem có tối ưu không.
2. Kết quả cũ của bạn ở cột D, E tôi dời sang cột G, H. Kết quả của tôi tôi nhập vào D, E. Bạn có thể so sánh và kiểm tra.
3. Lẽ ra macro phải lấy vùng dữ liệu được chọn để thao tác nhưng tôi lười. Nếu lấy thì code phải kiểm tra xem liệu vùng chọn có sai không, mà tôi thì lười. Hiện bạn có dữ liệu cột A, B bắt đầu từ dòng 16. Nếu tương lai khác thì bạn sửa lại code, tôi có ghi chú chỗ nào.
4. Hiện trong tập tin TXT bạn ghi kích thước là C30X20 (chữ X hoa). Trong tương lai bạn có thể nhập lẫn lộn "X" và "x" code vẫn cung phụng bạn. Riêng STORYa và Cbc ở sheet và TXT bạn phải viết hoa như bây giờ.
5. code tôi có giải thích, chắc bạn phải hiểu được
Mã:
Sub LocDuLieu()
Dim objRE As Object, colMatches As Object, fso As Object, Dic As Object
Dim r As Long, text As String, tmp As String, Arr, filename
Dim i As Long, size() As Long, resArr, rng As Range, trung As Boolean
' rng: vung du lieu, tuc cot A, B - cac dong tu dau den cuoi du lieu
' resArr: mang tra ve tai cot D, E
' Arr: mang cac gia tri cot A, B
' Dic: tu dien ghi nho cac khoa duy nhat loc tu tap tin TXT o dang STORYxCyz
' size: mang ghi nho cac kich thuoc tuong ung voi cac khoa dang STORYxCyz
On Error GoTo end_
filename = Application.GetOpenFilename
If filename = False Then GoTo end_
Range("D16:E65536").ClearContents ' neu vung du lieu khac thi sua lai
Set rng = Range([A16], [B65536].End(xlUp)) ' neu vung du lieu khac thi sua lai
Arr = rng.Value
ReDim resArr(1 To UBound(Arr), 1 To 2)
Set objRE = CreateObject("VBScript.RegExp")
Set fso = CreateObject("Scripting.FileSystemObject")
Set Dic = CreateObject("Scripting.Dictionary")
' doc toan bo tap tin TXT
text = fso.OpenTextFile(filename).ReadAll
Set fso = Nothing
With objRE
.Global = True
.MultiLine = True
.Pattern = "^\s+(STORY\d+)\s+(C\d+)[\s\w]+?(\d+)(X|x)(\d+)[\s\w]+?$"
Set colMatches = .Execute(text)
End With
ReDim size(0 To colMatches.count - 1, 2 To 3)
i = 0
' thuc hien cho tung dong doc duoc tu tap tin TXT
For r = 0 To colMatches.count - 1
' tao khoa dang STORYxCyz
tmp = colMatches.Item(r).SubMatches(0) & colMatches.Item(r).SubMatches(1)
' neu khoa chua co trong tu dien thi them vao
If Not Dic.Exists(tmp) Then
' kich thuoc thu nhat
size(i, 2) = colMatches.Item(r).SubMatches(2)
' kich thuoc thu hai
size(i, 3) = colMatches.Item(r).SubMatches(4)
' them vao tu dien
Dic.Add tmp, i
i = i + 1
End If
Next r
Set colMatches = Nothing
Set objRE = Nothing
i = 1
' ta duyet tu dong du lieu dau tien
While i <= UBound(Arr)
' tao khoa tu o B va A
tmp = Arr(i, 2) & Arr(i, 1)
If i > 1 Then
' neu khoa o dong hien tai trung voi khoa cua dong lien tren thi trung = TRUE,
' nguoc lai trung = FALSE
trung = tmp = Arr(i - 1, 2) & Arr(i - 1, 1)
Else
trung = False
End If
If trung Then
' khoa trung voi dong tren nen ta lay kich thuoc cua dong tren nhung hoan vi chung
resArr(i, 1) = resArr(i - 1, 2)
resArr(i, 2) = resArr(i - 1, 1)
ElseIf Dic.Exists(tmp) Then
' khoa khong trung nen ta lay tu mang size. Truoc tien ta xac dinh khoa o dong
' nao trong tu dien
r = Dic.Item(tmp)
' ta lay kich thuoc tu mang size
resArr(i, 1) = size(r, 2)
resArr(i, 2) = size(r, 3)
End If
i = i + 1
Wend
Set Dic = Nothing
' Ta "dap" mang ket qua xuong sheet
Range("D16").Resize(UBound(resArr), 2).Value = resArr ' neu vung du lieu khac thi sua lai
end_:
End Sub
Upvote
0
Cảm ơn bác nhiều,code chạy quá tốt nhưng khi e import file Text khác nó không chạy.Mong bác xem giúp trong file đính kèm:
Upvote
0
Khi import tập tin text thì dĩ nhiên ta phải biết cấu trúc của nó. Bạn đưa cho tôi một tập tin và tôi kiểm tra xem cấu trúc, xem có những ký tự nào. Tôi thấy ổn.
Với tập tin mới này thì khác. Mỗi dòng dữ liệu ở cuối dòng có "N/A", Thế thì không chạy là phải.
Vì ký tự "/" nó không phải "dấu trắng" (space, ký tự xuống dòng, tab, ...) cũng không thuộc tập "A-Za-z0-9_", mà trong code tôi dùng \s = [ \f\n\r\t\v], và \w = [A-Za-z0-9_]
Cũng do tôi thôi. Nếu tôi lường trước được sự đa dạng của dữ liệu thì tôi phải cho Pattern khác.
Bây giờ sửa chút, mà thậm chí không cần lấy hết dòng mà chỉ cần lấy tới "CabXxy" thôi
Tức thay "[\s\w]+?" bằng ".+?" và cắt cụt đoạn cuối
Trong code chỗ có Pattern thì sửa thành
PHP:
.Pattern = "^\s+(STORY\d+)\s+(C\d+).+?(\d+)(X|x)(\d+)"Tất nhiên bạn có thể đọc từng dòng dữ liệu từ TXT rồi dùng Split để tách chúng ra thành các đoạn.
Do tôi "chơi" VBScript.RegExp nên đẻ ra lắm chuyện. Thôi đã trót rồi.
Upvote
0
