Copy khi thoả điều kiện

[longlt08]

Xin chào các anh chị GPE !
Tôi có nhu cầu cần copy số liệu từ cột dọc chuyển thành cột khác ứng với điều kiện giá trị >0 và đúng với ký hiệu của đơn vị. Nhờ mọi người giúp đỡ. Xin cảm ơn ! (có file gửi kèm theo)

 

[ndu96081631]

Xin chào các anh chị GPE !
Tôi có nhu cầu cần copy số liệu từ cột dọc chuyển thành cột khác ứng với điều kiện giá trị >0 và đúng với ký hiệu của đơn vị. Nhờ mọi người giúp đỡ. Xin cảm ơn ! (có file gửi kèm theo)

Vầy thử xem:

Sub Test()
  Dim Clls As Range, ColRng As Range
  For Each Clls In Sheet1.Range("C2:C1000").SpecialCells(2)
    Set ColRng = Sheet1.Range("E1:J1").Find(Clls.Offset(, 1), , xlValues, xlWhole)
    If Not ColRng Is Nothing Then Sheet1.Cells(Clls.Row, ColRng.Column) = Clls
  Next
End Sub

Chỉ lưu ý 1 chuyện: Với Excel 2007, nếu file có chứa code VBA thì nhớ Save As thành định dạng xlsm mới có thể dùng được

 

[longlt08]

Vầy thử xem:

Sub Test()
Dim Clls As Range, ColRng As Range
For Each Clls In Sheet1.Range("C2:C1000").SpecialCells(2)
Set ColRng = Sheet1.Range("E1:J1").Find(Clls.Offset(, 1), , xlValues, xlWhole)
If Not ColRng Is Nothing Then Sheet1.Cells(Clls.Row, ColRng.Column) = Clls
Next
End Sub

Xin cảm ơn ndu96081631 ! Tôi đã thử code của anh ở file trích dẫn, kết quả đã được như ý. Rất cảm ơn anh đã giúp đỡ. Tôi đang vận dụng vào file dữ liệu gốc. Anh cho tôi hỏi thêm: có thể dùng thêm 1 cách bằng hàm được không ? file dữ liệu gốc của tôi đã dùng khá nhiều macro rồi.

 

[ptm0412]

Vầy thử xem:

Xin cảm ơn ndu96081631 ! Tôi đã thử code của anh ở file trích dẫn, kết quả đã được như ý. Rất cảm ơn anh đã giúp đỡ. Tôi đang vận dụng vào file dữ liệu gốc. Anh cho tôi hỏi thêm: có thể dùng thêm 1 cách bằng hàm được không ? file dữ liệu gốc của tôi đã dùng khá nhiều macro rồi.

Cách 1: công thức

E2=IF($D2=E$1,$C2,0)

hoặc

E2=($D2=E$1)*$C2

Fill xuống và ngang

Cách 2: pivot table

 

[ptm0412]

Thử dùng Dic và mảng, áp dụng Dic.Item(i), để không xài lại quên nữa. Vả lại, nếu dữ liệu rất nhiều, dùng mảng sẽ nhanh hơn.

Option Base 1
''__________________________________________

Sub abc()
Dim Dic As Object, ArrC, ArrKQ, EndR As Long

    Set Dic = CreateObject("Scripting.Dictionary")
    EndR = [a65000].End(xlUp).Row
    ArrC = [C2].Resize(EndR - 1, 2)
    ReDim ArrKQ(EndR - 1, 6)
    For i = 1 To 6
        Dic.Add [E1].Offset(0, i - 1).Value, i
    Next
    For i = 1 To EndR - 1
        ArrKQ(i, Dic.Item(ArrC(i, 2))) = ArrC(i, 1)
    Next
    Range("E2").Resize(EndR - 1, 6) = ArrKQ
End Sub

 

[longlt08]

Cách 1: công thức

E2=IF($D2=E$1,$C2,0)

hoặc

E2=($D2=E$1)*$C2

Fill xuống và ngang

Cách 2: pivot table

Xin chào ptm0412 !
Công thức anh làm giúp cho kết quả đúng khi dùng trong sheet bình thường không có dòng ẩn. Tôi áp dụng trong file có dòng ẩn(do dùng fillter), khi fill xuống thì sai địa chỉ không cho kết quả đúng nữa. Muốn có kết quả đúng lại phải sửa lại địa chỉ của ô, rất mất thời gian khi bảng dữ liệu lớn. Tôi muốn nhờ anh viết giúp đoạn code chỉ copy những ô nhìn thấy thôi(bỏ những ô ẩn), khi đó có thể dùng macro để thực hiện. Xin cảm ơn anh !

 

[ptm0412]

Thật lạ nhỉ? Anh có chú ý các dấu $ không? Hay là sau khi filter, dòng đầu không phải dòng 2 và anh không thay tham chiếu dòng $D2 và $C2?

 

[longlt08]

Thật lạ nhỉ? Anh có chú ý các dấu $ không? Hay là sau khi filter, dòng đầu không phải dòng 2 và anh không thay tham chiếu dòng $D2 và $C2?

Đúng là có sự nhầm lẫn, mình xin lỗi ! Khi thử ở file trích dẫn thì được nhưng khi lắp vào file dữ liệu gốc(file đang làm viêc) thì có nhầm lẫn. Tôi đã kiểm tra và sửa lại được rồi. Xin cảm ơn anh ! Nhân tiện cho tôi hỏi thêm:
- File dữ liệu gốc của tôi dùng pivot, do dùng nhiều biểu trích xuất nên dung lượng đã lên tới trên 3 MB, có cách gì để giảm độ lớn của file xuống không ?
- Ở bài trên tôi có thấy anh dùng mảng và dic. Tôi muốn anh giải thích thêm về đoan Sub đó được không ?
- Tôi có thử đoạn code test của ndu96081631 thấy chạy được ở file copy nhưng khi làm thành macro trong file dữ liệu lớn của tôi thì lại chẳng được(file dữ liệu của tôi có khoảng 1600 dòng và cột thì tới AZ). Tôi muốn hiểu thêm về cách dùng mảng và dic. của anh trong bài viết trên. Rất cảm ơn anh về sự giúp đỡ !

 

[ptm0412]

Nếu chỉ gán công thức (hoặc giá trị) cho những ô hiện thì dùng code sau, mặc dù tôi không hiểu tại sao sao chép công thức xuống bị sai tham chiếu. Và cũng không hiểu ý anh là gì, vì khi xả filter hoặc khi filter với điều kiện khác thì những dòng ẩn hiện ra sẽ không có giá trị.

Sub def()
Dim EndR As Long
    EndR = [a65000].End(xlUp).Row
    Range("e2:J" & EndR).SpecialCells(12).FormulaR1C1 = _
    "=(RC4=R1C)*RC3"
End Sub

 

[ptm0412]

Xin giải thích từ từ như sau:

Trước tiên cần phải xác định là lấy từng giá trị của từng cell trên 1 vùng bảng tính, tính toán, rồi gán giá trị cho từng cell của 1 vùng khác trên bảng tính thì rất chậm so với dùng mảng.

Dùng mảng nghĩa là tạo 1 biến mảng có số dòng và cột tương ứng với số dòng cột cần gán giá trị trên bảng tính, gán giá trị cho mảng sau đó gán nguyên mảng xuống bảng tính 1 lượt.

Ta có thể dùng thêm 1 mảng lấy dữ liệu nguồn để truy xuất từ mảng đó cho nhanh hơn.

Nếu dùng mảng thông thường, ta tạo 1 mảng EndR dòng và 6 cột. Ta phải gán giá trị cho mọi phần tử của mảng (EndR * 6 phần tử), căn cứ vào điều kiện truy xuất từ mảng nguồn EndR dòng và 2 cột (C, D) tương ứng.

Tuy nhiên căn cứ vào yêu cầu cụ thể của bài này, ta thấy chỉ cần gán giá trị EndR lần, mỗi dòng chỉ gán giá trị cho 1 phần tử, giảm chỉ cần 1/6 thời gian. Vấn đề là không biết cột nào.

Ta có thể dùng Match để tìm vị trí cột, nhưng tôi làm xong bị ndu chê. (chuyện cũ ấy mà). Thế là tôi dùng Dictionary.

Dictionary gồm có 2 thành phần: Keys là những giá trị không trùng, và Items là những giá trị khác, tương ứng với từng key. Nếu ta đánh số cho Items như số thứ tự từ 1 đến hết, ta có thể truy xuất xem 1 Key bất kỳ có số thứ tự bao nhiêu. Đó là cái tôi tận dụng để lấy số thứ tự cột trong mảng nói trên.

 

[TrungChinhs]

Vầy thử xem:

Sub Test()
Dim Clls As Range, ColRng As Range
For Each Clls In Sheet1.Range("C2:C1000").SpecialCells(2)
Set ColRng = Sheet1.Range("E1:J1").Find(Clls.Offset(, 1), , xlValues, xlWhole)
If Not ColRng Is Nothing Then Sheet1.Cells(Clls.Row, ColRng.Column) = Clls
Next
End Sub

Xin cảm ơn ndu96081631 ! Tôi đã thử code của anh ở file trích dẫn, kết quả đã được như ý. Rất cảm ơn anh đã giúp đỡ. Tôi đang vận dụng vào file dữ liệu gốc. Anh cho tôi hỏi thêm: có thể dùng thêm 1 cách bằng hàm được không ? file dữ liệu gốc của tôi đã dùng khá nhiều macro rồi.

@ anh Long, Code của Ndu là quá ngon rồi (ngắn gọn, chạy nhanh, kết quả chính xác). Chỉ có điều khi vận dụng, anh phải sửa tên Sheet1 trong code thành tên Sheet... thực tế của anh làm là OK.

 

[longlt08]

Thử dùng Dic và mảng, áp dụng Dic.Item(i), để không xài lại quên nữa. Vả lại, nếu dữ liệu rất nhiều, dùng mảng sẽ nhanh hơn.

Option Base 1
''__________________________________________
 
Sub abc()
Dim Dic As Object, ArrC, ArrKQ, EndR As Long
 
    Set Dic = CreateObject("Scripting.Dictionary")
    EndR = [a65000].End(xlUp).Row
    ArrC = [C2].Resize(EndR - 1, 2)
    ReDim ArrKQ(EndR - 1, 6)
    For i = 1 To 6
        Dic.Add [E1].Offset(0, i - 1).Value, i
    Next
    For i = 1 To EndR - 1
        ArrKQ(i, Dic.Item(ArrC(i, 2))) = ArrC(i, 1)
    Next
    Range("E2").Resize(EndR - 1, 6) = ArrKQ
End Sub

Xin cảm ơn anh ptm0412 !
Tôi đã thử đoạn code trên của anh trong file copy gửi lên diễn đàn-Kết quả chưa được như ý. Tôi đã gán cho macro thực hiện đoạn code trên
(trong sub của macro tôi bỏ đoạn Option Base 1 do Excel 2007 của tôi không chịu) kết quả là khi macro thực hiện xong Sub đó thì cột E không có kết quả-d1 không có số liệu. Các dòng khác bị chuyển dịch xuông 1 dòng (vẫn copy được số liệu. Tôi gửi lại file copy, trong đó có 2 macro:
-Macro1: dùng code của ndu
-Macro2: dùng code của anh
Anh xem giúp tôi về sai sót ở chỗ nào nên kq chưa đúng. Cảm ơn anh !

 

[TrungChinhs]

...
(trong sub của macro tôi bỏ đoạn Option Base 1 do Excel 2007 của tôi không chịu) kết quả là khi macro thực hiện xong Sub đó thì cột E không có kết quả-d1 không có số liệu. Các dòng khác bị chuyển dịch xuông 1 dòng (vẫn copy được số liệu

Anh xem bài này:
http://www.giaiphapexcel.com/forum/...-trong-code-lọc-duy-nhất!&p=247675#post247675

 

[ptm0412]

Chính vì thiếu Option Base 1 mà kết quả lệch 1 dòng và lệch 1 cột.

Khi copy có lẽ anh xóa dấu nháy trong dòng này:

' '_______________________________________

nên bị lỗi. Bản thân dòng Option Base 1 không lỗi.

Còn code của ndu, mới dự trù 1000 dòng, dữ liệu nhiều hơn thì không ra kết quả từ dòng 1001 trở đi.
For Each Clls In Sheet1.Range("C2:C1000").SpecialCells(2)

Để test cả 2 code tôi đã chỉnh số 1000 thành số lớn hơn.

Anh xem file, so sánh 2 code về tốc độ khi số dòng dữ liệu trên 16.000 dòng.
Kết quả thời gian ghi tại L1 và L2

http://www.mediafire.com/file/dr1k7d987vx2xja/copyptm.rar

Với 64.000 dòng:

http://www.mediafire.com/file/gfn1rm1b4grf7m9/copyptm2.rar

nhanh gấp 20 lần

 

[longlt08]

Xin cảm ơn anh ptm !
Xem ví dụ của anh, tôi đã biết mình sai ở chỗ nào. Rất cảm ơn anh về sự giúp đỡ và những giải thích về việc sử dụng mảng và Dic.
Thú thật, "dân không chuyên" như tôi phải nghiền ngẫm nhiều mới dần hiểu được về VBA. Mong được anh giúp đỡ thêm !