Chuyên đề: Cải Tiến Code VBA Excel (1 người xem)

today100506 · 13/8/13

Sub filldulieu()
Application.ScreenUpdating = False

Dim wb As Workbook
Dim ws As Worksheet

Set wb = Workbooks("HANGHOA.xlsm")

Set ws = wb.Sheets("NHAP")
ws.Range("rangefillnhap1Copy").Copy
With ws.Range("rangefillnhap1paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillnhap1paste").Value
End With
ws.Range("rangefillnhap2Copy").Copy
With ws.Range("rangefillnhap2paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillnhap2paste").Value
End With

Set ws = wb.Sheets("KHOCHINHXUAT")
ws.Range("rangefillKhochinhxuat1Copy").Copy
With ws.Range("rangefillKhochinhxuat1paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillKhochinhxuat1paste").Value
End With
ws.Range("rangefillKhochinhxuat2Copy").Copy
With ws.Range("rangefillKhochinhxuat2paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillKhochinhxuat2paste").Value
End With

Set ws = wb.Sheets("TONCUOI")
ws.Range("rangefillToncuoiCopy").Copy
With ws.Range("rangefillToncuoiPaste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillToncuoiPaste").Value
End With

Set ws = wb.Sheets("XUATLUUCHUYEN")
ws.Range("rangefillXuatluuchuyenCopy").Copy
With ws.Range("rangefillXuatluuchuyenPaste")
.PasteSpecial xlPasteValues
End With

Set ws = wb.Sheets("XUATBUFFET")
ws.Range("rangefillXuatbuffetCopy").Copy
With ws.Range("rangefillXuatbuffetPaste")
.PasteSpecial xlPasteValues
End With

Set ws = wb.Sheets("XUATK")
ws.Range("rangefillXuatkCopy").Copy
With ws.Range("rangefillXuatkPaste")
.PasteSpecial xlPasteValues
End With

'Application.ScreenUpdating = True: Exit Sub
End Sub

Tóm lại: Copy dữ liệu rồi paste,

Nhưng vấn đề là: mỗi sheet copy và paste vào những vùng khác nhau. (đã cố định vị trí).

Câu hỏi là: Viết lại code như thế nào cho đơn giản.
Em xin cảm ơn !
(ghi chú: code trên đang hoạt động tốt).

siwtom · 14/8/13

today100506 đã viết:
Sub filldulieu()
Application.ScreenUpdating = False

Dim wb As Workbook
Dim ws As Worksheet

Set wb = Workbooks("HANGHOA.xlsm")

Set ws = wb.Sheets("NHAP")
ws.Range("rangefillnhap1Copy").Copy
With ws.Range("rangefillnhap1paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillnhap1paste").Value
End With
ws.Range("rangefillnhap2Copy").Copy
With ws.Range("rangefillnhap2paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillnhap2paste").Value
End With

Set ws = wb.Sheets("KHOCHINHXUAT")
ws.Range("rangefillKhochinhxuat1Copy").Copy
With ws.Range("rangefillKhochinhxuat1paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillKhochinhxuat1paste").Value
End With
ws.Range("rangefillKhochinhxuat2Copy").Copy
With ws.Range("rangefillKhochinhxuat2paste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillKhochinhxuat2paste").Value
End With

Set ws = wb.Sheets("TONCUOI")
ws.Range("rangefillToncuoiCopy").Copy
With ws.Range("rangefillToncuoiPaste")
.PasteSpecial xlPasteFormulas
.Value = ws.Range("rangefillToncuoiPaste").Value
End With

Set ws = wb.Sheets("XUATLUUCHUYEN")
ws.Range("rangefillXuatluuchuyenCopy").Copy
With ws.Range("rangefillXuatluuchuyenPaste")
.PasteSpecial xlPasteValues
End With

Set ws = wb.Sheets("XUATBUFFET")
ws.Range("rangefillXuatbuffetCopy").Copy
With ws.Range("rangefillXuatbuffetPaste")
.PasteSpecial xlPasteValues
End With

Set ws = wb.Sheets("XUATK")
ws.Range("rangefillXuatkCopy").Copy
With ws.Range("rangefillXuatkPaste")
.PasteSpecial xlPasteValues
End With

'Application.ScreenUpdating = True: Exit Sub
End Sub

Tóm lại: Copy dữ liệu rồi paste,

Nhưng vấn đề là: mỗi sheet copy và paste vào những vùng khác nhau. (đã cố định vị trí).

Câu hỏi là: Viết lại code như thế nào cho đơn giản.
Em xin cảm ơn !
(ghi chú: code trên đang hoạt động tốt).

Bạn không gửi tập tin mà tôi lại không có thói quen làm những việc mà người hỏi có thể làm được. Vậy tôi dán code vào notepad rồi vừa nhìn vừa sửa. Code không được test nên có thể sai
---------------
Làm một lần ngay từ đầu, vd. khi mở tập tin

Mã:

Private arrSheet(), arrSourceRng(), arrDestRng()
.....

    arrSheet = Array("NHAP", "NHAP", "KHOCHINHXUAT", "KHOCHINHXUAT", "TONCUOI", "XUATLUUCHUYEN", "XUATBUFFET", "XUATK")
    arrSourceRng = Array("rangefillnhap1Copy", "rangefillnhap2Copy", "rangefillKhochinhxuat1Copy", "rangefillKhochinhxuat2Copy", "rangefillToncuoiCopy", "rangefillXuatluuchuyenCopy", "rangefillXuatbuffetCopy", "rangefillXuatkCopy")
    arrDestRng = Array("rangefillnhap1paste", "rangefillnhap2paste", "rangefillKhochinhxuat1paste", "rangefillKhochinhxuat2paste", "rangefillToncuoiPaste", "rangefillXuatluuchuyenPaste", "rangefillXuatbuffetPaste", "rangefillXuatkPaste")

sub

Mã:

Sub filldulieu()
Dim wb As Workbook, ws As Worksheet, index As Long
    Application.ScreenUpdating = False
    Set wb = Workbooks("HANGHOA.xlsm")

    For index = LBound(arrSheet) To UBound(arrSheet)
        Set ws = wb.Sheets(arrSheet(index))
        ws.Range(arrSourceRng(index)).Copy
        With ws.Range(arrDestRng(index))
            .PasteSpecial xlPasteFormulas
            .value = .value
        End With
    Next index

    Application.ScreenUpdating = True
End Sub

------------------------

Nhìn code dài hoa cả mắt cứ tưởng ở "mọi nơi" đều có xlPasteFormulas. Hóa ra ở gần cuối có 3 lần xlPasteValues. Thế thì sửa lại, và tiện thể rút gọn nữa.

Mã:

Sub filldulieu()
Dim wb As Workbook, ws As Worksheet, index As Long
    Application.ScreenUpdating = False
    Set wb = Workbooks("HANGHOA.xlsm")

    For index = LBound(arrSheet) To UBound(arrSheet)
        Set ws = wb.Sheets(arrSheet(index))
        ws.Range(arrSourceRng(index)).Copy
        ws.Range(arrDestRng(index)).PasteSpecial xlPasteValues
    Next index

    Application.ScreenUpdating = True
End Sub

ptm0412 · 14/8/13

Công nhận anh siwtom vẫn còn siêng. Hễ tôi thấy file có tên sheet dài là tôi sửa ngắn lại rồi mới làm. Name cũng vậy. Thà tôi xóa hết làm lại.
Không có file là tôi bỏ.

Làm trong notepad đã đành dài ngắn gì cũng chỉ copy, nhưng thấy ngứa mắt lắm.

siwtom · 14/8/13

ptm0412 đã viết:
Công nhận anh siwtom vẫn còn siêng. Hễ tôi thấy file có tên sheet dài là tôi sửa ngắn lại rồi mới làm. Name cũng vậy. Thà tôi xóa hết làm lại.
Không có file là tôi bỏ.

Làm trong notepad đã đành dài ngắn gì cũng chỉ copy, nhưng thấy ngứa mắt lắm.

Nếu có nhiều lựa chọn thì có lẽ tôi cũng bỏ đấy. Nhưng anh bảo nếu số bài nó như nấm trong mùa hạn hán ấy thì cũng phải đành lòng. Có vài bài mà mọi người "luộc" hết rồi thì xương xẩu cũng phải chịu thôi. Tôi chưa tới mức không có bài thì "sống làm gì nữa" nhưng chân tay ngứa ngáy "không ngủ được". He he.

huuthang_bd · 14/8/13

siwtom đã viết:
Bạn không gửi tập tin mà tôi lại không có thói quen làm những việc mà người hỏi có thể làm được. Vậy tôi dán code vào notepad rồi vừa nhìn vừa sửa. Code không được test nên có thể sai
---------------
Làm một lần ngay từ đầu, vd. khi mở tập tin

Mã:

Private arrSheet(), arrSourceRng(), arrDestRng() ..... arrSheet = Array("NHAP", "NHAP", "KHOCHINHXUAT", "KHOCHINHXUAT", "TONCUOI", "XUATLUUCHUYEN", "XUATBUFFET", "XUATK") arrSourceRng = Array("rangefillnhap1Copy", "rangefillnhap2Copy", "rangefillKhochinhxuat1Copy", "rangefillKhochinhxuat2Copy", "rangefillToncuoiCopy", "rangefillXuatluuchuyenCopy", "rangefillXuatbuffetCopy", "rangefillXuatkCopy") arrDestRng = Array("rangefillnhap1paste", "rangefillnhap2paste", "rangefillKhochinhxuat1paste", "rangefillKhochinhxuat2paste", "rangefillToncuoiPaste", "rangefillXuatluuchuyenPaste", "rangefillXuatbuffetPaste", "rangefillXuatkPaste")

sub

Mã:

Sub filldulieu() Dim wb As Workbook, ws As Worksheet, index As Long Application.ScreenUpdating = False Set wb = Workbooks("HANGHOA.xlsm") For index = LBound(arrSheet) To UBound(arrSheet) Set ws = wb.Sheets(arrSheet(index)) ws.Range(arrSourceRng(index)).Copy With ws.Range(arrDestRng(index)) .PasteSpecial xlPasteFormulas .value = .value End With Next index Application.ScreenUpdating = True End Sub

------------------------

Nhìn code dài hoa cả mắt cứ tưởng ở "mọi nơi" đều có xlPasteFormulas. Hóa ra ở gần cuối có 3 lần xlPasteValues. Thế thì sửa lại, và tiện thể rút gọn nữa.

Mã:

Sub filldulieu() Dim wb As Workbook, ws As Worksheet, index As Long Application.ScreenUpdating = False Set wb = Workbooks("HANGHOA.xlsm") For index = LBound(arrSheet) To UBound(arrSheet) Set ws = wb.Sheets(arrSheet(index)) ws.Range(arrSourceRng(index)).Copy ws.Range(arrDestRng(index)).PasteSpecial xlPasteValues Next index Application.ScreenUpdating = True End Sub

Hình như code sửa lại không ổn anh ơi. Bỏ qua bước Paste Formula thì kết quả có thể không còn đúng nữa.

VetMini · 14/8/13

Thật sự tôi rất bội phục những bạn ở diễn đàn này về mức độ kiên nhẫn.
Tôi nhìn code trên 20 dòng, trên 5 biến (variables) mà không có chú thích (comments) là tôi hết muốn đọc tiếp.

Tôi chỉ đoán mang máng là hình như code này copy/paste một đống. Và cách copy/paste khá đồng nhất.
Trên nguyên tắc, có thể lập một sub copy/paste rồi gọi cho từng sheet/range. Tuy không hữu hiệu bằng vòng lặp và array nhưng dễ nhìn hơn.

today100506 · 14/8/13

VetMini đã viết:
Thật sự tôi rất bội phục những bạn ở diễn đàn này về mức độ kiên nhẫn.
Tôi nhìn code trên 20 dòng, trên 5 biến (variables) mà không có chú thích (comments) là tôi hết muốn đọc tiếp.

Tôi chỉ đoán mang máng là hình như code này copy/paste một đống. Và cách copy/paste khá đồng nhất.
Trên nguyên tắc, có thể lập một sub copy/paste rồi gọi cho từng sheet/range. Tuy không hữu hiệu bằng vòng lặp và array nhưng dễ nhìn hơn.

Em xin cảm ơn giải đáp của anh siwtom.
Em xin cảm ơn lời phàn nàn của thầy PTM.
Em xin cảm ơn comment của bạn VetMini. Em sẽ khắc phục.
Đây là một topic chuyên đề - xin cảm ơn tất cả các bạn đã quan tâm.
Hiện tại em đang tìm hiểu & ứng dụng excel thực tế nên cần giúp đỡ nhiều.
Em xin hứa, sau này em sẽ là một thành viên tích cực & thật sự có ích của GPE.

Đây là file mẫu. Anh (chị) viết code vào đây nhé. Giải thích dùm em luôn nhé.

Câu 1: MODULE 1: Copy/ paste dữ liệu (đã hỏi).
Done.
Câu 2: MODULE 2: Protect sheet & lock cell.
Anh chị cải tiến lại code dùm em.
Câu 3: Module 3: Unprotect sheet & Unlocked Cells
(không có gì để hỏi)
Câu 4: Module 4: OnOffAutoFilter
Em muốn khi ấn vào 1 cái thì nó sẽ bỏ AutoFilter hết các sheet.
Em muốn khi ấn vào 1 cái nữa thì nó sẽ AutoFilter hết các sheet.
(không biết mỗi sheet đã có autofilter hay chưa có autofilter)
Câu 5: MODULE 5: AUTO SUM
(Em muốn sum vùng các ô THANHTIEN đã select, KHÔNG SUM CÁC Ô ĐÃ FILTER)
(ghi chú: hiện tại nó sum hết các ô, kể cả các ô bị filter (ẩn đi).)

Note: Vì file xlsm dung lượng lớn. nên em đã luu file thành .xlsx và kèm theo module vba. Anh (chị) vui lòng import vào giúp em nhé. Em xin chân thành cảm ơn.

( ghi chú cho các bạn chưa biết Import vba
Save As file HANGHOA.xlsx thành HANGHOA.xlsm
Alt + F11 --> File\Import File\...module.bas\OK )

CÂU HỎI VỀ NAME DEFINE:
- Trong file excel của em có các name define, bây giờ các anh (chị) chỉ quan tâm đến name define correcspondingList thôi nhé. Nó có vấn đề thế này: Hiện tại, mỗi sheet em khai báo 1 name define "CorrecspondingList" riêng, rất là thủ công và mất công. Anh (chị) sửa lại cho nó gọn dùm em nhé (chắc là sửa cho worksheet hết - test kỹ dùm em).

CÂU HỎI PHỤ:
Câu 1: Done.
Câu 2: Khi gửi đề tài: em muốn tab đầu dòng, viết code. Xin chỉ em cách.

TRỢ GIÚP:
Đây là một đề tài sẽ được cập nhật và hỏi thường xuyên, em mong mod và các bạn nhiệt tình ủng hộ, đây cũng là topic đầu tiên có tiềm năng của em đối với GPE, nay em nhờ mod sửa lại tên đề tài dùm em nhé:
"Chuyên đề: Cải tiến hàng VBA Excel" --> "Chuyên đề: Cải tiến Hàm VBA Excel"
Em xin cảm ơn mod !

sealand · 14/8/13

Anh Siwtom ơi, Code vẫn còn gọn nữa:

Mã:

Sub filldulieu()
Dim index As Long
    Application.ScreenUpdating = False
    For index = LBound(arrSheet) To UBound(arrSheet)
    Sheets(arrSheet(index)).Range(arrDestRng(index)).Value = Sheets(arrSheet(index)).Range(arrSourceRng(index)).Value
    Next
    Application.ScreenUpdating = True
End Sub

today100506 · 14/8/13

sealand đã viết:

Anh Siwtom ơi, Code vẫn còn gọn nữa:

Mã:

Sub filldulieu()
Dim index As Long
    Application.ScreenUpdating = False
    For index = LBound(arrSheet) To UBound(arrSheet)
    Sheets(arrSheet(index)).Range(arrDestRng(index)).Value = Sheets(arrSheet(index)).Range(arrSourceRng(index)).Value
    Next
    Application.ScreenUpdating = True
End Sub

Lỗi rồi sealand ơi:
Vba bôi đen chỗ arrSourceRng và báo lỗi
Compile error: Sub or Function not defined
code anh siwtom cũng bị báo lỗi như vậy !!!

ptm0412 · 14/8/13

sealand đã viết:
Anh Siwtom ơi, Code vẫn còn gọn nữa:

Sealand ơi, range nguồn và range đích kích thước khác nhau, không chơi kiểu này được.

siwtom · 14/8/13

today100506 đã viết:
Lỗi rồi sealand ơi:
Vba bôi đen chỗ arrSourceRng và báo lỗi
Compile error: Sub or Function not defined
code anh siwtom cũng bị báo lỗi như vậy !!!

Thế bạn có cái sau không?
-------------
Làm một lần ngay từ đầu, vd. khi mở tập tin

Mã:

Private arrSheet(), arrSourceRng(), arrDestRng()
.....

    arrSheet = Array("NHAP", "NHAP", "KHOCHINHXUAT", "KHOCHINHXUAT", "TONCUOI", "XUATLUUCHUYEN", "XUATBUFFET", "XUATK")
    arrSourceRng = Array("rangefillnhap1Copy", "rangefillnhap2Copy", "rangefillKhochinhxuat1Copy", "rangefillKhochinhxuat2Copy", "rangefillToncuoiCopy", "rangefillXuatluuchuyenCopy", "rangefillXuatbuffetCopy", "rangefillXuatkCopy")
    arrDestRng = Array("rangefillnhap1paste", "rangefillnhap2paste", "rangefillKhochinhxuat1paste", "rangefillKhochinhxuat2paste", "rangefillToncuoiPaste", "rangefillXuatluuchuyenPaste", "rangefillXuatbuffetPaste", "rangefillXuatkPaste")

ptm0412 · 14/8/13

today100506 đã viết:
Lỗi rồi sealand ơi:
Vba bôi đen chỗ arrSourceRng và báo lỗi
Compile error: Sub or Function not defined
code anh siwtom cũng bị báo lỗi như vậy !!!

Bạn chép đoạn này vào chưa mà bảo code lỗi?

Mã:

Private arrSheet(), arrSourceRng(), arrDestRng()
 .....      
arrSheet = Array("NHAP", "NHAP", "KHOCHINHXUAT", "KHOCHINHXUAT", "TONCUOI", ...)     
arrSourceRng = Array("rangefillnhap1Copy", "rangefillnhap2Copy", ...)     
arrDestRng = Array("rangefillnhap1paste", "rangefillnhap2paste", ...)

today100506 · 14/8/13

ptm0412 đã viết:
Bạn chép đoạn này vào chưa mà bảo code lỗi?

Mã:

Private arrSheet(), arrSourceRng(), arrDestRng() ..... arrSheet = Array("NHAP", "NHAP", "KHOCHINHXUAT", "KHOCHINHXUAT", "TONCUOI", ...) arrSourceRng = Array("rangefillnhap1Copy", "rangefillnhap2Copy", ...) arrDestRng = Array("rangefillnhap1paste", "rangefillnhap2paste", ...)

Đoạn code trên mình copy vào chỗ nào trong VBA,
..... dưới private là cái gì vậy )):
đừng chửi em nhé )):

siwtom · 14/8/13

today100506 đã viết:
Đoạn code trên mình copy vào chỗ nào trong VBA,

Tôi tưởng bạn biết chút về code chứ?

Bạn có thể đặt trong module nhưng lúc đó

Mã:

[COLOR=#ff0000]Private/Public[/COLOR] arrSheet(), arrSourceRng(), arrDestRng()

Public Sub Init()     
    arrSheet = Array("NHAP", "NHAP", "KHOCHINHXUAT", "KHOCHINHXUAT", "TONCUOI", ...)    
    arrSourceRng = Array("rangefillnhap1Copy", "rangefillnhap2Copy", ...)     
    arrDestRng = Array("rangefillnhap1paste", "rangefillnhap2paste", ...)
End Sub

Nếu Sub filldulieu cũng nằm trong cùng module thì chỗ đỏ đỏ có thể (nhưng không bắt buộc) là Private, ngược lại phải là Public.

Bạn muốn thực hiện 1 lần? Phải chuột lên ThisWorkbook --> View code

Mã:

Private Sub Workbook_Open()
    Init
End Sub

Nói chung có thể giải quyết theo nhiều cách. Nếu bạn vẫn không biết làm thì

Mã:

Sub filldulieu()
Dim wb As Workbook, ws As Worksheet, index As Long
Dim arrSheet(), arrSourceRng(), arrDestRng()
    arrSheet = Array("NHAP", "NHAP", "KHOCHINHXUAT", "KHOCHINHXUAT", "TONCUOI", ...)    
    arrSourceRng = Array("rangefillnhap1Copy", "rangefillnhap2Copy", ...)     
    arrDestRng = Array("rangefillnhap1paste", "rangefillnhap2paste", ...)
    ... code còn lại
End Sub

Còn việc "kia" để khi nào thành cao thủ/pro thì quay lại xét.
-----------------
Tôi chỉ làm qua cho bạn thôi. Cái chính là ý tưởng dùng vòng lặp. Mọi chuyện còn lại chỉ là chi tiết thực hiện ý tưởng đó. Có người thì làm như tôi viết qua ở trên. Có người thì tạo Sub với dữ liệu đầu vào là source range và dest range, và thực hiện việc copy/paste. Lúc đó thì Sub có thể dùng "mãi mãi", còn trong Sub filldulieu() thì trong vòng lặp chỉ gọi Sub "mãi mãi" kia thôi. Tất cả những cái đó chỉ là chi tiết cách thực hiện. Vd. ý tưởng là phải làm cái bàn thế này thế này. Nhưng mỗi người thợ sẽ làm theo cách của mình, với kinh nghiệm, dụng cụ và công nghệ của mình.

[QUOTE
..... dưới private là cái gì vậy )):
đừng chửi em nhé )):[/QUOTE]

Khi người ta dùng "..." thì có nghĩa là ở chỗ đó có thể có nhiều code (sub, function) khác. Một module có thể có nhiều code chứ chắc gì chỉ 1 sub? Mà tôi liệt kê "các việc phải làm" thôi chứ code không thể "đứng trơ trọi" thế được. Phải cho vào Sub.

today100506 · 14/8/13

Em cảm ơn anh siwtom nhé, anh nhiệt tình quá ...hiiii

Còn mấy câu hỏi nữa, sau hum thấy ai trả lời hết )): thread #7 đó @@

Em đang chờ...

Chuyên đề: Cải Tiến Code VBA Excel (1 người xem)

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

today100506

Thành viên chính thức

siwtom

Thành viên gắn bó

ptm0412

Bad Excel Member

siwtom

Thành viên gắn bó

huuthang_bd

Chuyên gia GPE

VetMini

Đang đi tìm hòn đá

today100506

Thành viên chính thức

sealand

Thành viên gạo cội

today100506

Thành viên chính thức

ptm0412

Bad Excel Member

siwtom

Thành viên gắn bó

ptm0412

Bad Excel Member

today100506

Thành viên chính thức

siwtom

Thành viên gắn bó

today100506

Thành viên chính thức

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

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

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