hungtttv
Thành viên mới

- Tham gia
- 6/2/10
- Bài viết
- 22
- Được thích
- 13
Nếu như mình muốn diễn đạt :không có giá trị nào của A=B thì viết thế nào bác?Cái nào nghĩ không ra thì cứ IF... IF... gì gì đó (như ta nói) cũng sẽ ra thôi
Nếu như mình muốn diễn đạt :không có giá trị nào của A=B thì viết thế nào bác?Cái nào nghĩ không ra thì cứ IF... IF... gì gì đó (như ta nói) cũng sẽ ra thôi
Mình suy nghĩ thế này, không biết có đúng không.Nếu như mình muốn diễn đạt :không có giá trị nào của A=B thì viết thế nào bác?
Em làm sub xóa hàng thì ok nhưng cứ xóa cột là các dữ liệu bên ngoài bên phải của vùng chọn lại bị mất hết. Với xóa cột thì em dùng delete 1 theo như bác ndu. Em thử bằng shift cell left của excel thì dữ liệu bên phải ngoài vùng không bị mất. Vì sao vậy?Theo cách hiểu của Mình là: Bạn bấm chọn 1 ô bất kỳ -> Bấm phải chuột chọn Delete -> Nó sẽ xuất hiện hộp thoại Delete -> Xem thứ tự từ trên xuống
Delete Shist Cells Left (Tương ứng là 1)
Delete Shist Cells Up (Tương ứng là 2)
.......
Giờ hãy xem lại hàm của bạn nha! Trong code của bạn có đoạn:Nếu như mình muốn diễn đạt :không có giá trị nào của A=B thì viết thế nào bác?
Function TachSo(ByVal x1 As String) As Integer
Dim p1 As Long
Dim p2 As Long
For i = 1 To Len(x1)
If IsNumeric(Mid(x1, i, 1)) = True Then
p1 = i
Exit For
End If
Next
If p1 > 0 Then
For i = p1 To Len(x1)
If IsNumeric(Mid(x1, i, 1)) = False Then
p2 = i
Exit For
End If
Next
End If
TachSo = CInt(Mid(x1, p1, p2 - p1))
End Function
Ủa! Hàm này để làm gì vậy ta?Đề bài (bài 1): Viết hàm tìm số nguyên trong 1 chuỗi
Bài làm:
Mã:Function TachSo(ByVal x1 As String) As Integer Dim p1 As Long Dim p2 As Long For i = 1 To Len(x1) If IsNumeric(Mid(x1, i, 1)) = True Then p1 = i Exit For End If Next If p1 > 0 Then For i = p1 To Len(x1) If IsNumeric(Mid(x1, i, 1)) = False Then p2 = i Exit For End If Next End If TachSo = CInt(Mid(x1, p1, p2 - p1)) End Function
Function Ten(ByVal y1 As String) As String
Dim x1 As Integer
For i = Len(y1) To 1 Step -1
If Mid(y1, i, 1) = " " Then
x1 = i
Exit For
End If
Next i
Ten = Right(y1, Len(y1) - x1)
End Function
Function Ho(ByVal y2 As String) As String
Dim x2 As Integer
For i = Len(y2) To 1 Step -1
If Mid(y2, i, 1) = " " Then
x2 = i
Exit For
End If
Next i
Ho = IIf(x2 > 0, Left(y2, x2 - 1), "")
End Function
Ho = IIf(x2 > 0, Left(y2, x2 - 1), "")
If x2 > 0 Then Ho = Left(y2, x2 - 1)
If x2 > 0 Then Ho = Left(y2, x2 - 1)
Tuy nhiên hàm tách họ của em chưa hoàn thiện, nếu tên chỉ gồm một âm tiết (chẳng hạn như "Thắng" hay "Ngọc" thì nó báo lỗi.
Thưa thầy vì trình độ của chúng em, nên giới hạn là chỉ cần tìm được 1 số nguyên đầu tiên là được. Số 42 trong ví dụ của thầy là số nguyên đầu tiên trong chuỗi
Để tìm tiếp các số em cũng sẽ làm được bằng cách thêm vào các đoạn vòng lặp, nhưng kiểu gì nó cũng là một số giới hạn (vd 4 số, hoặc 5 số nếu thêm 5 vòng lặp). Còn để tìm một cách vô hạn thì em chưa nghĩ ra làm kiểu gì? Để tìm một số có số lẻ sau số thập phân, hay tìm 1 số có định dạng kiểu 1.000.000 trong chuỗi cũng ngoài khả năng.
Function Ten2(ByVal y3 As String) As String
Ten2 = Right(y3, Len(y3) - InStrRev(y3, " ", -1, vbTextCompare) + 1)
End Function
Thưa thầy, bài tách họ tên em nghĩ ra 1 cách rất ngắn ứng dụng hàm đã học, nhưng khi chạy nó báo lỗi #REF, em chưa tìm ra được sai ở đâu? Đây là code tách tên
Mã:Function Ten2(ByVal y3 As String) As String Ten2 = Right(y3, Len(y3) - InStrRev(y3, " ", -1, vbTextCompare) + 1) End Function
Public Function Ten2(ByVal Chuoi As String) As String
Myr = Trim(Chuoi)
Ten2 = Right(Myr, Len(Myr) - InStrRev(Myr, " "))
End Function
Public Function Tachho(ByVal Chuoi As String) As String
Dim Myr
Myr = InStr(1, Chuoi, " ")
Ten = Left(Chuoi, Myr)
End Function
Cái này nó vẫn báo lỗi #REFAnh Thắng thử xem cài này nhé! Em sửa lại chút thôi:
PHP:Public Function Ten2(ByVal Chuoi As String) As String Myr = Trim(Chuoi) Ten2 = Right(Myr, Len(Myr) - InStrRev(Myr, " ")) End Function
Có lỗi gì đâu trời... Kế cả hàm của bạn cũng chạy tốt luônCái này nó vẫn báo lỗi #REF
Option Explicit
Function TachTen(ByVal HVT As String) As String
Dim Space As String
Space = InStrRev(Trim(HVT), " ", -1, vbTextCompare)
TachTen = Mid(HVT, Space + 1, Len(Trim(HVT)))
End Function
-----------------------------------------------------------
Function TachHo(ByVal HVT As String) As String
Dim Space As String
Space = InStrRev(HVT, " ", -1, vbTextCompare)
TachHo = Mid(HVT, 1, Space)
End Function
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.....
Code của bạn có đoạn: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.....
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
For Each op In Me.Frame1.Controls
If op.Value Then Cells(jJ, 1).Offset(, 1).Value = op.Caption
Next
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
Ngọc làm form rất tốt! Nhưng cần phải để lại thông tin về nguồn code sử dụ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 không hiểu ý thầy Tuân lắm! Có phải ý thầy là đưa code lên đây?
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ì đó.
UserForm2.lstDanhsach.AddItem Sheets("[COLOR=red]Sheet2[/COLOR]").Cells(Row, 2)
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 ạ!!!
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
Đây là bài tập tối ngày 18.11.2010:
Em nhờ thầy và các AC xem và hoàn thiện code cho em sao cho tối ưu hơn.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
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.
If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!"
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!"
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à.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!"
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
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.. NextEm nhờ thầy và các AC xem và hoàn thiện code cho em sao cho tối ưu hơn.
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
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
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
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
If eRw1 = 10 Then MsgBox "Khong tim thay. Vui long tim lai nha!" : Exit Sub
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
Lớp mình tham khảo bài tập của mình ở mục này nhé!
Find đính kèm ne....
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ỉ?
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
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?
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
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é
Anh Minh ơi, em check mail rùi nhưng đâu có!? Anh kiểm tra lại nha!
Sorry chú nhé. Anh hôm nay loay cái vụ mất dữ liệu mãi. chuă gửi được.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!
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
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
Public MyRibbonUI As IRibbonUI [COLOR="darkgreen"]'Biến nhận điều khiển Ribbon[/COLOR]
Dim bHasFile As Boolean [COLOR="darkgreen"]'Biến nhận trạng thái Enabled[/COLOR]
[COLOR="green"]'Callback for customUI.onLoad
'Get instance to RibbonUI[/COLOR]
Sub [COLOR="blue"]OnLoadUI[/COLOR](ribbon As IRibbonUI)
Set MyRibbonUI = ribbon
End Sub
[COLOR="green"]'Callback for customButton getEnabled[/COLOR]
Sub [COLOR="blue"]OnGetEnabled[/COLOR](control As IRibbonControl, ByRef returnedVal)
returnedVal = bHasFile
End Sub
[COLOR="green"]
'Callback for customButton1 onAction[/COLOR]
Sub guiThuKemFile(control As IRibbonControl)
bHasFile = Not bHasFile
[COLOR="green"] 'Refresh "File Dinh Kem" button[/COLOR]
MyRibbonUI.InvalidateControl "customButton2" [COLOR="darkgreen"]'"[B]customButton2[/B]" là id của nút "File Đính Kèm"[/COLOR]
[COLOR="green"] 'Answer[/COLOR]
MsgBox "Thu nay " & IIf(bHasFile, "phai", "khong") & " chua file di kem"
End Sub
Bài học về menu này quá hay, xin lỗi vì em đang công tác nên không làm bài gửi lên mạng được.
Ai hôm thứ 3 không đi học thì rất phí, nên xem và thứ 5 đi học lại. Thứ 5 cũng là buổi cuối rồi
Em đang có nhu cầu học nâng cao hơn nữa. Lớp mình có ai cũng có nhu cầu như em liên lạc để tổ chức học thêm nha.
Bài học về menu này quá hay, xin lỗi vì em đang công tác nên không làm bài gửi lên mạng được.
Ai hôm thứ 3 không đi học thì rất phí, nên xem và thứ 5 đi học lại. Thứ 5 cũng là buổi cuối rồi
Em đang có nhu cầu học nâng cao hơn nữa. Lớp mình có ai cũng có nhu cầu như em liên lạc để tổ chức học thêm nha.
Cám ơn thầy Hướng về tài liệu rất hay này. Thầy Hướng cho em hỏi: Em đã tải phần mềm Inno Setup về cài rùi nhưng phiên bản này nó bắt mua hay sao đó ah?Đây là bài viết về Những nguyên tắc cơ bản xây dựng phần mềm trên Excel để lớp học tham khảo.
Cám ơn thầy Hướng về tài liệu rất hay này. Thầy Hướng cho em hỏi: Em đã tải phần mềm Inno Setup về cài rùi nhưng phiên bản này nó bắt mua hay sao đó ah?
Thầy gửi cho em xin phần mềm Inno Setup (bản free) và gửi vào mail: ngoc.dak@gmail.com dùm em nhé!
Cám ơn thầy Hướng nhiều!
Tiếc là cậu không đi mấy buổi vừa rồi, thầy Tuân có mấy bài rất hay về Ribbon (tuy nhiên học kiểu xml này cũng hơi mệt).
Inno Setup 5 là bản miễn phí mà, em tải ở đây
A lố...Alô.... Huongchuoi đâu rùi. Dow file về test đi. Chắc đêm nay chỉ ngồi bấm cái Icon "trái tim" thôi ah. Nếu hỏng chuột ngoài thì dùng chuột Laptop nhé. Nghe giang hồ đồn thổi thangacc cài 1 đoạn code bí mật, nếu click vào "trái tim" 9999^1000 lần thì nó sẽ hiện lên Msgbox với lời nhắn:........ Click đủ mới biêt. Không chơi ViewCode đâu nhé. Code này ẩn rùi.Em gửi bài tập của em hôm thứ 3, mặc dù hơi muộn. Bài tập cũng là một chút thư giãn với lớp, mong các thầy góp ý. (nếu có gì không phải mong các anh chị bỏ qua nhé, Vui là chính ạ)
Đề bài: Làm một menu Ribbon trong đó vừa có menu cũ của office, vừa có menu mới riêng. Trong Tab mới vừa có nút bấm của office, vừa có các nút bấm riêng. Các nút bấm phải đảm bảo có các thuộc tính hiện: Label, Screentip, Supertip. Tạo một nút bấm mà trạng thái enable = false. (menu tiếng việt).
Hôm qua (thứ 5) có bài tập gì không vậy ạ?
A lố...Alô.... Huongchuoi đâu rùi. Dow file về test đi. Chắc đêm nay chỉ ngồi bấm cái Icon "trái tim" thôi ah. Nếu hỏng chuột ngoài thì dùng chuột Laptop nhé. Nghe giang hồ đồn thổi thangacc cài 1 đoạn code bí mật, nếu click vào "trái tim" 9999^1000 lần thì nó sẽ hiện lên Msgbox với lời nhắn:........ Click đủ mới biêt. Không chơi ViewCode đâu nhé. Code này ẩn rùi.)
Em gửi bài tập của em hôm thứ 3, mặc dù hơi muộn. Bài tập cũng là một chút thư giãn với lớp, mong các thầy góp ý. (nếu có gì không phải mong các anh chị bỏ qua nhé, Vui là chính ạ)
Đề bài: Làm một menu Ribbon trong đó vừa có menu cũ của office, vừa có menu mới riêng. Trong Tab mới vừa có nút bấm của office, vừa có các nút bấm riêng. Các nút bấm phải đảm bảo có các thuộc tính hiện: Label, Screentip, Supertip. Tạo một nút bấm mà trạng thái enable = false. (menu tiếng việt).
Hôm qua (thứ 5) có bài tập gì không vậy ạ?
em đã phát hiện ra. anh Minh dám lừa em nha. a cứ chờ xem em sẽ xử lý anh như thế nào
Hương bấm 1000 lần à? khổ thân em. Do yêu cầu của đề bài nên mới cần phải có trái tim kia, cũng là chút thư giãn.
Em có file bài hôm thứ 5 của thầy có thể zip nó lại rồi gửi mail giúp anh không?
mail của anh thangacc@gmail.com
Lý do tại sao phải ấn vào trái tim thì em cứ để chuột lên trên cái logo của em nó sẽ hiện lên nhé. Đây là bài anh làm theo đúng yêu cầu của thầy mà (có cả supertip)
Bỏ làm sao được cơ chớ. Chót "thương", chót "nhớ", chót vấn vương rùi....Một ngày dù bận đến mấy cũng phải "dạo" qua một vòng xem dân tình GPE thế nào. Lớp mình có ai chăm học không. Có sáng kiến ý tưởng gì mới không. Mỗi tội bản thân chưa làm nên được việc gì cả.có vẻ như anh Minh sợ quá bỏ cả diễn đàn rùi ah?????????
Thân gửi thangacc chiểu theo đề nghị của bạn huongchuoi tôi đã gửi toàn bộ thông tin liên quan đến bổi học thứ 12 vào mail của lớp mình. Bao gồm cả bộ cài đặt các chương trình liên quan.
Các thành viên khác không tham gia được hai buổi cuối dow về tham khảo.
Nếu ai đọc mà chưa hiểu, Cần phụ đạo thêm thì mời thangacc và huongchuoi đi uống cafe là ổn ngay thôi. Nhớ gọi cả tui nữa nhé.
có vẻ như anh Minh sợ quá bỏ cả diễn đàn rùi ah?????????
Đề nghị thangacc đọc #282Em gửi giúp anh bài hôm thứ 5 vào email đi, anh chưa thấy
tôi đã gửi toàn bộ thông tin liên quan đến bổi học thứ 12 vào mail của lớp mình. Bao gồm cả bộ cài đặt các chương trình liên quan.
Cái trái tim ấy làm gì mà click 1000 cái. Hai cái còn chả được.
Click cái thứ nhất thì enable được nút "huongchuoi", nhấn cái thứ 2 đã báo lỗi câu này rồi:
MyRibbonUI.InvalidateControl "huongchuoi" '
Em bấm gần 1000 lần không thấy báo lỗi, ấn lần 1 nick em Hương sáng, bấm lần 2 tối, lần 3 sáng, lần 4 tối, 5 sáng, 6 tối, sáng, tối, sáng, tối..... Như kiểu "yêu/không yêu/yêu/không yêu/yêu/không yêu..." ý vui lắm
Đến 1000 lần sẽ thấy cái vui hơn anh Minh nhỉ
Làm em Huong hỏng mất chuột rùi. Chủ nhật này gặp lại nhớ mua chuột đền nhé.Như kiểu "yêu/không yêu/yêu/không yêu/yêu/không yêu..."
Em bấm gần 1000 lần không thấy báo lỗi, ấn lần 1 nick em Hương sáng, bấm lần 2 tối, lần 3 sáng, lần 4 tối, 5 sáng, 6 tối, sáng, tối, sáng, tối..... Như kiểu "yêu/không yêu/yêu/không yêu/yêu/không yêu..." ý vui lắm
Đến 1000 lần sẽ thấy cái vui hơn anh Minh nhỉ
Đúng là mình bấm cũng nhiều nhiều. không thấy báo lỗi mà. Chắc office của bác ptm0412 là 2003 rùi.
Còn cái vụ
Làm em Huong hỏng mất chuột rùi. Chủ nhật này gặp lại nhớ mua chuột đền nhé.
Đúng là mình bấm cũng nhiều nhiều. không thấy báo lỗi mà. Chắc office của bác ptm0412 là 2003 rùi.
Còn cái vụ
Làm em Huong hỏng mất chuột rùi. Chủ nhật này gặp lại nhớ mua chuột đền nhé.
2003 làm gì có ribbon mà test trời?
Hôm đó tôi test bằng 2010 thì bị lỗi, hôm nay test bằng 2007 thì không lỗi. Tức quá, test lại bằng 2010, lần này không lỗi nữa. Chắc sức mạnh tình iu của cái trái tim làm cho test code lần đầu bị run rẩy rồi. Sorry nhé.
anh phải mua con chuột xịn đấy nhé. tại anh mà hỏng hết rùi
Trời! chuột "xịn" hả để xin phép mod giao vặt tại đây 1 tin:
Có ai biết chuột không dây mà có "thu" bi bán ở đâu không vậy? Chỉ giúp em mua mai còn đền cho người ta.
giá nào E cũng chịu ah.
Thôi...thôi tuần này thì đã học xong rùi nhé. Post bài lên đi huongchuoi ơi. Chém gió nhiều quácó đấy có đấy. nhưng anh phải trả cả đời đấy. anh có chịu ko?????
Tiếc là cậu không đi mấy buổi vừa rồi, thầy Tuân có mấy bài rất hay về Ribbon (tuy nhiên học kiểu xml này cũng hơi mệt).
Inno Setup 5 là bản miễn phí mà, em tải ở đây
Thầy Hướng ơi, em xem phần mềm Inno Setup đóng gói rất tiện. Nhưng em mò mãi không làm thành công. Thầy vui lòng chỉ dẫn cho em nhé!!