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
Hôm qua, khi học về, ngồi nhớ lại những gì đã học và đã làm bài tập nhỏ này. Mọi người tham khảo nha.....
 

File đính kèm

  • BAI TAP VE FORM.rar
    51.4 KB · Đọc: 36
NH_DK đã viết:
Hôm qua, khi học về, ngồi nhớ lại những gì đã học và đã làm bài tập nhỏ này. Mọi người tham khảo nha.....
Nhấp chuột vào đây để mở rộng...
Code của bạn có đoạn:
PHP: 
If OptionVietNam Then
  Cells(jJ, 1).Offset(, 1).Value = "Nguoi Viet Nam"
ElseIf OptionAnh Then
  Cells(jJ, 1).Offset(, 1).Value = "Nguoi Anh"
ElseIf OptionPhap Then
  Cells(jJ, 1).Offset(, 1).Value = "Nguoi Phap"
End If
Sao bạn không dùng vòng lập nhỉ? Đã học rồi cơ mà ---> Sửa thành vầy sẽ gọn hơn và đồng thời có tiếng Việt luôn
PHP: 
For Each op In Me.Frame1.Controls
  If op.Value Then Cells(jJ, 1).Offset(, 1).Value = op.Caption
Next
Và nếu là tôi thì tôi sẽ sửa toàn bộ code này thành:
PHP: 
Private Sub cmdOK_Click()
  Dim op As Control
  With Sheets("DATA").Range("A65535").End(xlUp)
    If TextBox1.Value = "" Then
      MsgBoxUni UNC("B¹n h·y ®iÒn tªn vµo nhÐ. C¸m ¬n b¹n nhiÒu!")
    Else
      .Offset(1, 0).Value = TextBox1.Value
      For Each op In Me.Frame1.Controls
        If op.Value Then .Offset(1, 1).Value = op.Caption
      Next
      TextBox1 = ""
      TextBox1.SetFocus
    End If
  End With
End Sub
 
Lần chỉnh sửa cuối:
Cám ơn thầy ndu nhiều! Tại hôm qua học về muộn quá, trong khi ngồi chờ cơm tối thì em làm tạm. Thấy cũng chạy Ok nên em cũng không làm lại nữa (Hi...... mệt quá thầy ah!). Chiều em muốn đưa lên cho các bạn cùng lớp tham khảo nữa!
Cám ơn những đóng góp thật ý nghĩa của Thầy!
 
NH_DK đã viết:
Em không hiểu ý thầy Tuân lắm! Có phải ý thầy là đưa code lên đây?
Nhấp chuột vào đây để mở rộng...
Ý thầy Tuân là anh phải trích dẫn nguồn code sử dụng (Trong bài là nguồn code để viết tiếng Việt Unicode)
Em thấy chỉ có những chữ trong msgbox mới viết được tiếng Việt, còn trong cell thì chưa có. Các thầy có thể hướng dẫn cho lớp viết tiếng Việt trên bảng tính (chung cho mọi trường hợp chứ không chỉ riêng bài này) được không ạ?
 
Lần chỉnh sửa cuối:
Các thầy cho em hỏi sao em làm UserForm lọc dữ liệu (theo ví dụ 7 của thầy Hướng) lúc đầu chạy thì ổn nhưng khi em làm tiếp UserForm khác thì lại không chạy được cái UserForm trước (UserForm2), nó cứ báo runtime error 9 gì đó.
 

File đính kèm

  • BT UserForm2.rar
    28.5 KB · Đọc: 16
khanhhoan đã viết:
Các thầy cho em hỏi sao em làm UserForm lọc dữ liệu (theo ví dụ 7 của thầy Hướng) lúc đầu chạy thì ổn nhưng khi em làm tiếp UserForm khác thì lại không chạy được cái UserForm trước (UserForm2), nó cứ báo runtime error 9 gì đó.
Nhấp chuột vào đây để mở rộng...
Mã: 
      UserForm2.lstDanhsach.AddItem Sheets("[COLOR=red]Sheet2[/COLOR]").Cells(Row, 2)

Không phải tại UserForm sau làm hư UserForm trước gì cả. Do tên sheet đã sửa thành "BT 7" rồi, có còn là "Sheet2" nữa đâu.

Ngoài ra trong code có dùng biến j, và cho j = j +1. Rút cục j chẳng dùng vào việc gì hết?
 
Lần chỉnh sửa cuối:
Thầy ơi có mấy cái bài tập ấy không gửi mail giúp em, em không có sách thành ra không hiểu làm cái gì cả. Thank you thầy nhiều ạ.
Email: thangacc@gmail.com
 
Hai buổi tuần trước vì bận công việc em không đi học được, các thầy hay bác nào đi học đầy đủ có thể tóm tắt những gì mình học 2 buổi đó giúp em được không ạ? Em cảm ơn trước ạ!!!
 
Ui, hôm trước có học không mà sao không thấy mọi người làm bài tập vậy?
 
Đây là bài tập tối ngày 18.11.2010:
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
    '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
        .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
Em nhờ thầy và các AC xem và hoàn thiện code cho em sao cho tối ưu hơn.
 

File đính kèm

  • BTvba.rar
    176.6 KB · Đọc: 23
Lần chỉnh sửa cuối:
NH_DK đã viết:
Đây là bài tập tối ngày 18.11.2010:
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
    '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
        .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
Em nhờ thầy và các AC xem và hoàn thiện code cho em sao cho tối ưu hơn.
Nhấp chuột vào đây để mở rộng...

Ngọc sửa thêm thế này nhé.
+ Khai báo biến ở đầu thủ tục. Hiện nay có những lệnh gán trước phần khai báo biến như là Application.ScreenUpdating = False.
+ Khi không tìm thấy mã thì thông báo sau đó bị lỗi?

Ngọc kiểm tra và chỉnh thêm nhé. Code cũng khá tốt đây.
 
Nguyễn Duy Tuân đã viết:
Ngọc sửa thêm thế này nhé.
+ Khai báo biến ở đầu thủ tục. Hiện nay có những lệnh gán trước phần khai báo biến như là Application.ScreenUpdating = False.
+ Khi không tìm thấy mã thì thông báo sau đó bị lỗi?

Ngọc kiểm tra và chỉnh thêm nhé. Code cũng khá tốt đây.
Nhấp chuột vào đây để mở rộng...

Thầy ơi em bẫy như thế này chưa được uh?
PHP: 
If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!"
 
NH_DK đã viết:
Thầy ơi em bẫy như thế này chưa được uh?
PHP: 
If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!"
Nhấp chuột vào đây để mở rộng...
Không thấy mã thông báo thì được rồi, nhưng thông báo xong phải thoát ra, chứ hè hụi đi định dạng border và number cho cái không có ấy mà.
Còn cái ScreeenUpdating nữa, trước khi thoát ra phải trả lại = True.
 
Dạ có phải như thế này không ah?
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
    '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
        .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
    Exit Sub:
    Set ShSoCtiet = Nothing
    Set ShSoData = Nothing
End Sub
 
Lần chỉnh sửa cuối:
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

solomon2211
PDF Tools giúp ghép, tách, xóa file pdf
Trả lời
0
Đọc
1
solomon2211
solomon2211
T
Cần bạn viết phần mềm quản lý quán karaoke bằng excel
Trả lời
4
Đọc
70
tonyteo1994
T
ann266
Kế toán kho F&B
Trả lời
1
Đọc
45
hoangtuaotrang_hp_vn
H
pthau72
Xin hỗ trợ giúp em!
Trả lời
0
Đọc
8
pthau72
pthau72
T
  • Question
Xin giúp chọn nhiểu phần tử của drop list cùng 1 lúc
Trả lời
3
Đọc
83
tle2003
T
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