Chú ý: Các thành viên học lớp "Lập trình VBA trong Excel" có thể trao đổi bài ở đây

Liên hệ QC
Lớp mình tham khảo bài tập của mình ở mục này nhé!
Code:
PHP: 
Option Explicit
Sub Loc_Ctiet()
Application.ScreenUpdating = False
    Dim ShSoCtiet As Worksheet
    Dim ShSoData As Worksheet
    Set ShSoCtiet = Sheets("SOCTIET")
    Set ShSoData = Sheets("CSDL")
    Dim eRw As Long, eRw1 As Long, i As Long, Kyhieu As String, Ma As String
    'Xoa du lieu
    ShSoCtiet.Range("A10:G56536").Clear 'Contents
    eRw1 = 10
    With ShSoCtiet
        Kyhieu = Trim(.[c6])
        Ma = Trim(.[c7])
        For eRw = 4 To ShSoData.[a65536].End(xlUp).Row
            'Dieu kien
            If Trim(ShSoData.Cells(eRw, 1)) = Kyhieu And Trim(ShSoData.Cells(eRw, 4)) = Ma Then
                'Lay du lieu sang neu dieu kien la dung
                .Cells(eRw1, 1).Resize(, 2) = ShSoData.Cells(eRw, 2).Resize(, 2).Value
                .Cells(eRw1, 3).Resize(, 6) = ShSoData.Cells(eRw, 5).Resize(, 6).Value
                eRw1 = eRw1 + 1
            End If
        Next
    End With
    'Thong bao neu khong tim thay va thoat luon
    If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!": Exit Sub
    i = Range("A65535").End(xlUp).Row + 1
    With [A10].Resize(i - 9, 7) 'Ke bang
        .BorderAround LineStyle:=1
        .Borders(11).LineStyle = 1: .Borders(11).ColorIndex = 7
        .Borders(12).LineStyle = 1: .Borders(12).ColorIndex = 7
    End With
    With Cells(i, 3) 'Dien chu Cong vao bang
            .Value = "Cong"
            .Font.Bold = True
    End With
    With Cells(i, 7)  'Cong tong cot G
            .Value = "=SUM(R10C7:R" & i - 1 & "C)"
            .Font.Bold = True
    End With
    Range("E10:G" & i).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)" ' Dinh dang so
    Application.ScreenUpdating = True
    Set ShSoCtiet = Nothing
    Set ShSoData = Nothing
End Sub
Find đính kèm ne....
 

File đính kèm

  • BTvba.rar
    177 KB · Đọc: 19
ndu96081631 đã viết:
Tối ưu nhất và gọn nhất theo tôi là viết code dựa trên cơ sở AutoFilter hoặc Advanced Filter chứ không phải dùng For.. Next
Nhấp chuột vào đây để mở rộng...

Vì đây là mang tính học thuật nên không khuyến kích sử dụng các chức năng sẵn có của Excel bác ạ, vì nhiều người có thể phát triển thêm VBA for Cad, VB6, VB.NET,... nữa.
 
NH_DK đã viết:
Dạ có phải như thế này không ah?
PHP: 
Option Explicit

Sub Loc_Ctiet()
......
            ''Dieu kien
            If Trim(ShSoData.Cells(eRw, 1)) = Kyhieu And Trim(ShSoData.Cells(eRw, 4)) = Ma Then
                ''Lay du lieu sang neu dieu kien la dung
                .Cells(eRw1, 1).Resize(, 2) = ShSoData.Cells(eRw, 2).Resize(, 2).Value
                .Cells(eRw1, 3).Resize(, 6) = ShSoData.Cells(eRw, 5).Resize(, 6).Value
                eRw1 = eRw1 + 1
            End If
        Next
    End With
    ''Bay loi
    If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!"    
    i = Range("A65535").End(xlUp).Row + 1
    With [A10].Resize(i - 10, 7) 'Ke bang
        ......
    Exit Sub:
    Set ShSoCtiet = Nothing
    Set ShSoData = Nothing
End Sub
Nhấp chuột vào đây để mở rộng...

Phải thoát ra ngay khi thông báo xong. Viết như trên thì có thoát đâu, vẫn chạy từ đầu đến đuôi!
Nếu thoát ngay mà không làm gì cả thì:
PHP: 
If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!"    : Exit Sub
Nhưng phải trả Application.Screen... về True, và giải phóng bộ nhớ nữa, nên phải tạo 1 Label. Khi đã tạo label mà muốn thoát thì phải có GoTo.

Thí dụ:
PHP: 
If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!"    : GoTo Exit1
    'Code đóng khung & định dạng'
    ......

Exit1:
    Application.ScreenUpdating = True
    Set ShSoCtiet = Nothing
    Set ShSoData = Nothing
    Exit Sub
End Sub

Một cái lỗi nữa: Khi lọc được dữ liệu thoả điều kiện:

- Chỉ đóng khung và định dạng cho dữ liệu tìm thấy, không đóng khung định dạng cho dòng cộng.
- Nếu chỉ có 1 dòng dữ liệu tìm thấy, do đóng khung chỉ 1 dòng nên dòng lệnh đóng khung inside vertical border và inside horizontal border bị lỗi.

Khắc phục:
Thay i - 10 trong câu With [A10].Resize(i - 10, 7) bằng i - 9. Cái này là toán số học lẽ ra không được phép sai.

Một điểm khác:
Sao không dùng biến có sẵn eRw1 mà phải tính lại biến khác là i nhỉ?
 
ptm0412 đã viết:
Sao không dùng biến có sẵn eRw1 mà phải tính lại biến khác là i nhỉ?
Nhấp chuột vào đây để mở rộng...

Theo gợi ý của ptm0412, code của bài được hoàn thiện như sau:
PHP: 
Option Explicit
Sub Loc_Ctiet()
Application.ScreenUpdating = False
    Dim ShSoCtiet As Worksheet
    Dim ShSoData As Worksheet
    Set ShSoCtiet = Sheets("SOCTIET")
    Set ShSoData = Sheets("CSDL")
    Dim eRw As Long, eRw1 As Long, Kyhieu As String, Ma As String
    'Xoa du lieu
    ShSoCtiet.Range("A10:G56536").Clear 'Contents
    eRw1 = 10
    With ShSoCtiet
        Kyhieu = Trim(.[c6])
        Ma = Trim(.[c7])
        For eRw = 4 To ShSoData.[a65536].End(xlUp).Row
            'Dieu kien
            If Trim(ShSoData.Cells(eRw, 1)) = Kyhieu And Trim(ShSoData.Cells(eRw, 4)) = Ma Then
                'Lay du lieu sang neu dieu kien la dung
                .Cells(eRw1, 1).Resize(, 2) = ShSoData.Cells(eRw, 2).Resize(, 2).Value
                .Cells(eRw1, 3).Resize(, 6) = ShSoData.Cells(eRw, 5).Resize(, 6).Value
                eRw1 = eRw1 + 1
            End If
        Next
    End With
    'Thong bao neu khong tim thay va thoat luon
    If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!": GoTo lblExit
    'i = Range("A65535").End(xlUp).Row + 1
    With [A10].Resize(eRw1 - 9, 7) 'Ke bang
        .BorderAround LineStyle:=1
        .Borders(11).LineStyle = 1: .Borders(11).ColorIndex = 7
        .Borders(12).LineStyle = 1: .Borders(12).ColorIndex = 7
    End With
    With Cells(eRw1, 3)  'Dien chu Cong vao bang
            .Value = "Cong"
            .Font.Bold = True
    End With
    With Cells(eRw1, 7)  'Cong tong cot G
            .Value = "=SUM(R10C7:R" & eRw1 - 1 & "C)"
            .Font.Bold = True
    End With
    Range("E10:G" & eRw1).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)" ' Dinh dang so
lblExit:
   Application.ScreenUpdating = True
    Set ShSoCtiet = Nothing
    Set ShSoData = Nothing
End Sub
 
Lần chỉnh sửa cuối:
Trời ơi! Câu lệnh set ScreenUpdating = True phải để dưới dòng lblExit chứ! Để trên thì khi lỗi nó đâu có chạy?
Với lại, cho xin, đừng gọi chú xưng cháu trên GPE.
 
ptm0412 đã viết:
Trời ơi! Câu lệnh set ScreenUpdating = True phải để dưới dòng lblExit chứ! Để trên thì khi lỗi nó đâu có chạy?
Nhấp chuột vào đây để mở rộng...

Code ở #245 copy nhầm (đã hiệu chỉnh). Thật cẩu thả quá!! Cám ơn ptm0412 đã phát hiện ra. Thiệt là...hu hu...+-+-+-+
 
Lap so chi tiet

Bài của Ngọc viết đã chạy đúng khá tốt nhưng chưa áp dụng được hết các kiến thức đã học.

Dưới đây là đáp án bài tập về nhà của lớp học VBA. Bài giải của tôi dưới đây chỉ viết lên các kiến thức mà lớp đã được học trong thời gian vừa qua.

Các kiến thức ứng dụng trong bài tập này:
+ Khai báo biến
+ Khai báo hằng số
+ Khai báo và sử dụng Label
+ Khai thác đối tượng Range
+ Sử dụng vòng lặp For
+ Sử dụng khối lệnh IF
+ Lập trình an toàn với bẫy lỗi On Error
+ Lập trình trong thủ tục sự kiện của Worksheet
+ Lập trình tường minh (đọc dễ hiểu)

'Dưới đây là đáp án
Mã: 
Sub LocSoChitiet()
    [COLOR="seagreen"]'Bay loi[/COLOR]
    On Error GoTo lbEndSub
    [COLOR="seagreen"]'Khai bao bien, hang so[/COLOR]
    Dim ShSoCtiet As Worksheet
    Dim ShSoData As Worksheet
    Dim SoData_EndRow As Long, SoChiTiet_iRow As Long, SoData_iRow As Long[COLOR="seagreen"] 'Index of row[/COLOR]
    Dim Kyhieu As String, MaHang As String
    
    [COLOR="seagreen"]'Khai bao hang so[/COLOR]
    Const SoChiTiet_StartRow = 10
    Const SoSoData_StartRow = 4
    
    [COLOR="seagreen"]'Nhan doi tuong sheet cho cac so[/COLOR]
    Set ShSoCtiet = Sheets("SOCTIET")
    Set ShSoData = Sheets("CSDL")
    
    Application.ScreenUpdating = False
   [COLOR="seagreen"] 'Xoa du lieu[/COLOR]
    ShSoCtiet.Range("A" & SoChiTiet_StartRow & ":G65536").Clear[COLOR="seagreen"] 'Xoa toa bo noi dung va dinh dang[/COLOR]
    SoChiTiet_iRow = SoChiTiet_StartRow
    With ShSoCtiet
        Kyhieu = Trim(.Range("C6").Value)
        MaHang = Trim(.Range("C7").Value)
       [COLOR="green"] 'Chay tu dong dau tien toi dong cuoi cua SoData[/COLOR]
        SoData_EndRow = ShSoData.Range("A65536").End(xlUp).Row
        For SoData_iRow = SoSoData_StartRow To SoData_EndRow
           [COLOR="green"] 'Dieu kien[/COLOR]
            If Trim(ShSoData.Cells(SoData_iRow, 1)) = Kyhieu And Trim(ShSoData.Cells(SoData_iRow, 4)) = MaHang Then
                [COLOR="green"]'Lay du lieu tu So Kho sang neu dieu kien la dung[/COLOR]
                .Cells(SoChiTiet_iRow, 1).Value = ShSoData.Cells(SoData_iRow, 2).Value [COLOR="green"]'So CT[/COLOR]
                .Cells(SoChiTiet_iRow, 2).Value = ShSoData.Cells(SoData_iRow, 3).Value[COLOR="green"] 'Ngay CT[/COLOR]
                .Cells(SoChiTiet_iRow, 3).Value = ShSoData.Cells(SoData_iRow, 5).Value [COLOR="green"]'Dien giai[/COLOR]
                .Cells(SoChiTiet_iRow, 4).Value = ShSoData.Cells(SoData_iRow, 6).Value[COLOR="green"] 'DVT[/COLOR]
                .Cells(SoChiTiet_iRow, 5).Value = ShSoData.Cells(SoData_iRow, 7).Value[COLOR="green"] 'Slg[/COLOR]
                .Cells(SoChiTiet_iRow, 6).Value = ShSoData.Cells(SoData_iRow, 8).Value [COLOR="green"]'Don Gia[/COLOR]
                .Cells(SoChiTiet_iRow, 7).Value = ShSoData.Cells(SoData_iRow, 9).Value [COLOR="green"]'T.Tien[/COLOR]
                SoChiTiet_iRow = SoChiTiet_iRow + 1[COLOR="green"] 'Tang so dong len 1 don vi[/COLOR]
            End If
        Next
    End With
    [COLOR="green"]'Thong bao neu khong tim thay va thoat luon[/COLOR]
    If SoChiTiet_iRow = SoChiTiet_StartRow Then
        MsgBox "Khong tim thay. Vui long tim lai nha!", vbCritical
        GoTo lbEndSub
    End If
    [COLOR="green"]'Ke vien cho bang[/COLOR]
    With ShSoCtiet.Range("A" & SoChiTiet_StartRow & ":G" & SoChiTiet_iRow)
        .BorderAround LineStyle:=xlContinuous
        With .Borders(xlInsideVertical)[COLOR="green"] ' Vien doc[/COLOR]
            .LineStyle = xlContinuous
            .ColorIndex = vbBlack
        End With
        With .Borders(xlInsideHorizontal) [COLOR="green"]'Vien ngang[/COLOR]
            .LineStyle = xlContinuous
            .ColorIndex = vbBlack
        End With
    End With
   [COLOR="green"] 'Ghi dong Cong vao bang[/COLOR]
    With ShSoCtiet.Cells(SoChiTiet_iRow, 3)
        .Value = "Cong: "
        .Font.Bold = True
    End With
    With ShSoCtiet.Cells(SoChiTiet_iRow, 7)  'Cong tong cot G
        .Formula = "=SUM(G" & SoChiTiet_StartRow & ":G" & SoChiTiet_iRow - 1 & ")"
        .Font.Bold = True
    End With
  [COLOR="green"]  'Dinh dang cot tien te[/COLOR]
    ShSoCtiet.Range("F" & SoChiTiet_StartRow & ":G" & SoChiTiet_iRow).NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)"
    
[COLOR="green"]'Label[/COLOR]
lbEndSub:
    Application.ScreenUpdating = True
    Set ShSoCtiet = Nothing
    Set ShSoData = Nothing
    
[COLOR="green"]    'Neu co loi (Err<>0) thi thong bao loi[/COLOR]
    If Err <> 0 Then
        MsgBox Err.Description, vbCritical
    End If
End Sub

Các thành viên download file về chạy thử.
 

File đính kèm

  • vbaHaNoi_SoChiTiet.xls
    64 KB · Đọc: 29
Lần chỉnh sửa cuối:
Bài học ngày 23/11/2010 Thiết kế Form trong Excel và lập trình sự kiện
Nguyên văn file gốc của thầy Phan tự hướng

Upfile mãi toàn báo lỗi. File dung lượng vượt quá cho phép.
Mình đã gửi vào mail của lớp các bạn vào dow nhé
 
vuminh1601 đã viết:
Bài học ngày 23/11/2010 Thiết kế Form trong Excel và lập trình sự kiện
Nguyên văn file gốc của thầy Phan tự hướng

Upfile mãi toàn báo lỗi. File dung lượng vượt quá cho phép.
Mình đã gửi vào mail của lớp các bạn vào dow nhé
Nhấp chuột vào đây để mở rộng...

Anh Minh ơi, em check mail rùi nhưng đâu có!? Anh kiểm tra lại nha!
 
Khi chúng ta đang hị hụi duyệt qua từng ô của UsedRange để xác định xem sheet có rỗng không thì quên mất 1 vấn đề là:
Nếu Sheet rỗng thì IsEmpty(ActiveSheet.usedrange)=True. **~**

Vì vậy đoạn code hôm qua có thể sửa lại cho đơn giản và ngắn hơn nữa --=0.
 
Anh Minh ơi, anh gửi bài học hôm qua vào mail cho em nhé!
Cám ơn anh Minh nhiều!
 
NH_DK đã viết:
Anh Minh ơi, anh gửi bài học hôm qua vào mail cho em nhé!
Cám ơn anh Minh nhiều!
Nhấp chuột vào đây để mở rộng...
Sorry chú nhé. Anh hôm nay loay cái vụ mất dữ liệu mãi. chuă gửi được.
Tìm mãi bài không thấy nhờ hương gửi lại và gửi cho chú
 

File đính kèm

  • Gmail(3).zip
    33.3 KB · Đọc: 14
Sang tuần thầy Tuân sẽ có 1 buổi về menu (trong Excel 2003) và Ribbon trong 2007 vào ngày thứ 3 hoặc 5.
 
Còn hai buổi cuối cùng. Tôi sẽ cùng mọi người khai thác phần menu Ribbon và menu kiểu Office 2003 (nếu còn thời gian). Quá trình hướng dẫn tôi cũng nói luôn vè tổ chức menu trong một phần mềm.

IC14226.gif


Học tạo menu Ribbon là khó, ngay cả với người đã từng lập trình VBA nhìn cái này cũng đã hoa mắt, tuy nhiên tôi hy vọng chúng ta thật chú ý và cùng tôi khai thác là được.
Trước khi vào buổi tối nay, tôi muốn mọi người đọc trước lần lượt nỗi dung về menu Ribbon qua các đường link dưới đây:

Customizing the 2007 Office Fluent Ribbon for Developers (Part 1 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 2 of 3)
Customizing the 2007 Office Fluent Ribbon for Developers (Part 3 of 3)

OfficeCustomUIEditorSetup
2007 Office System Document: Lists of Control IDs
2007 Office System Document: UI Style Guide for Solutions and Add Ins
2007 Office System Add-In: Icons Gallery
2007 Office System Document: Developer Overview of the User Interface

Mọi cần thiết download tất cả tài liệu trên nhé. Nó là cẩm nang lập trinhg Ribbon sau này ta còn dùng nhiều.
 
Lần chỉnh sửa cuối:
thầy ơi,
em gửi thầy btvn em làm, em ko biết là đã được chưa. thầy xem giúp em với. em đã thêm nút enabled = false vào rồi nhưng em muốn là khi nút "thư có file đính kèm" được chọn thì nút " chọn file" sẽ sáng nhưng chưa biết làm thế nào. thầy góp ý giúp em để em làm tiếp ah
 

File đính kèm

  • btvn ve menu ribbon.xlsm.zip
    15.1 KB · Đọc: 11
huongchuoi đã viết:
thầy ơi,
em gửi thầy btvn em làm, em ko biết là đã được chưa. thầy xem giúp em với. em đã thêm nút enabled = false vào rồi nhưng em muốn là khi nút "thư có file đính kèm" được chọn thì nút " chọn file" sẽ sáng nhưng chưa biết làm thế nào. thầy góp ý giúp em để em làm tiếp ah
Nhấp chuột vào đây để mở rộng...

Hương ơi, em gửi cho anh bài học hôm nay vào mail này cho anh nữa nhé!
Cám ơn Hương nhiều!
 
huongchuoi đã viết:
thầy ơi,
em gửi thầy btvn em làm, em ko biết là đã được chưa. thầy xem giúp em với. em đã thêm nút enabled = false vào rồi nhưng em muốn là khi nút "thư có file đính kèm" được chọn thì nút " chọn file" sẽ sáng nhưng chưa biết làm thế nào. thầy góp ý giúp em để em làm tiếp ah
Nhấp chuột vào đây để mở rộng...

File em gửi chưa cắt bỏ phấn ".zip" nên mọi người không đọc được. Tôi cắt bỏ phần ".zip" và upload lại cho em.
Nhìn qua thấy tốt đố, có gì sẽ góp ý với em sau.
 

File đính kèm

  • Huongchuoi - btvn ve menu ribbon.zip
    12.6 KB · Đọc: 16
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

K
Giúp về tạo thư mục lưu trong VBA
Trả lời
3
Đọc
436
kazunoki
K
Maika8008
  • Đã giải quyết
[Chia sẻ] Dùng VBA trộn dữ liệu Excel sang file Word mẫu (tương tự chức năng Mail Merge)
    • Thích
    • Yêu thích
    • Cảm ơn
23 24 25
Trả lời
480
Đọc
38K
Hoàng Tuấn 868
H
TranThanhPhong
Hàm IF
    • Thích
Trả lời
5
Đọc
11K
phamchicong
P
L
Tính tổng và đếm ỗ đã chọn
Trả lời
4
Đọc
81
thuytrangbp28
T
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
4
Đọc
135
hunganh.nguyen
hunganh.nguyen
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom