Tất nhiên là dc.. cách sửa là làm thế nào đó thêm dấu nháy (') vào tên sheet.. Nhưng tôi khuyên bạn đừng bao giờ dùng cách đặt tên sheet và tên file kiểu vậy (Có khoảng trắng hoặc có dấu tiếng Việt)... Mai này bạn sẽ gặp ko ít rắc rối vì nó đấy!
Macro nó thế ni:
Option Explicit
Dim lRow As Long
Dim Rng As Range, RngCr As Range, RngDes As Range
Sub LapDSach()
' Macro recorded 4/5/2008 by SA_DQ (GPE.COM);'
Dim DienHS As String, Xh As String
Dim DesRow As Long
Xh = Chr(10) & Chr(13): Sheets("Ca Nam").Select
lRow = Range("A65432").End(xlUp).Row
Set Rng = Range("A2:U" & lRow): Set RngDes = Range("W5:AB5")
DienHS = "1: Luu Ban;" & Xh & "2: Thi Lai;" & Xh & "3: Ren Hanh Kiem;"
Application.ScreenUpdating = False
DienHS = InputBox(DienHS, "BAN CAN LAP DANH SACH NAO?", "1")
Select Case DienHS
Case 1
Range("Z2") = "Y": Range("AA2") = "Y"
DesRow = 8: Sheets("LbTlRhk").Range("C8:C20").ClearContents
Case 2
Range("Z2") = "<>Y": Range("AA2") = "Y"
DesRow = 24: Sheets("LbTlRhk").Range("C24:C35").ClearContents
Case 3
Range("Z2") = "Y": Range("AA2") = "<>Y"
DesRow = 40: Sheets("LbTlRhk").Range("C40:C49").ClearContents
End Select
Set RngCr = Range("W1:AB2")
AdvFilter
lRow = Range("X65432").End(xlUp).Row
Range("X6:X" & lRow).Copy Destination:=Sheets("LbTlRhk").Range("C" & DesRow)
Set Rng = Nothing
Set RngCr = Nothing: Set RngDes = Nothing
Sheets("LbTlRhk").Select
End SubSub AdvFilter()
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RngCr, CopyToRange:=RngDes, Unique:=False
End SubOption Explicit
Dim lRow As Long
Dim Rng As Range, RngCr As Range, RngDes As Range
Sub LapDSach()
' Macro recorded 4/5/2008 by SA_DQ (GPE.COM);'
Dim DienHS As String, Xh As String
Dim DesRow As Long
Xh = Chr(10) & Chr(13): Sheets("Ca Nam").Select
lRow = Range("A65432").End(xlUp).Row
Set Rng = Range("A2:U" & lRow): Set RngDes = Range("W5:AB5")
DienHS = "1: Luu Ban;" & Xh & "2: Thi Lai;" & Xh & "3: Ren Hanh Kiem;"
Application.ScreenUpdating = False
DienHS = InputBox(DienHS, "BAN CAN LAP DANH SACH NAO?", "A")
DienHS = UCase$(DienHS)
Select Case DienHS
Case "A"
Range("Z2") = "Y": Range("AA2") = "Y"
DesRow = 8: Sheets("LbTlRhk").Range("C8:C20").ClearContents
Case "B"
Range("Z2") = "<>Y": Range("AA2") = "Y"
DesRow = 24: Sheets("LbTlRhk").Range("C24:C35").ClearContents
Case "C"
Range("Z2") = "Y": Range("AA2") = "<>Y"
DesRow = 40: Sheets("LbTlRhk").Range("C40:C49").ClearContents
End Select
Set RngCr = Range("W1:AB2")
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=RngCr, _
CopyToRange:=RngDes, Unique:=False
2 'Chon Trong Cac Mon Kiem Tra Lai'
Dim RowTL As Long, jW As Long, JZ As Long
Dim MonThi As String, HoTen As String
RowTL = Range("X65432").End(xlUp).Row
If DienHS = "B" Then
For jW = 6 To RowTL
With Cells(jW, 24)
HoTen = .Value
For JZ = 3 To lRow
If Cells(JZ, 2) = HoTen Then
Set Rng = Cells(JZ, 2).Offset(, 1).Resize(1, 13)
For Each RngDes In Rng
If RngDes < 5 Then _
MonThi = MonThi & Cells(2, RngDes.Column) & "; "
Next RngDes
.Offset(, 5) = MonThi: MonThi = ""
End If
Next JZ
End With
Next jW
End If
Range("X6:X" & RowTL).Copy Destination:=Sheets("LbTlRhk").Range("C" & DesRow)
If DienHS = "B" Then _
Range("AC6:AC" & RowTL).Copy Destination:=Sheets("LbTlRhk").Range("E" & DesRow)
Set Rng = Nothing
Set RngCr = Nothing: Set RngDes = Nothing
Sheets("LbTlRhk").Select: Range("C" & DesRow).Select
End SubHiện tại mình dùng công thức nhưng phải dùng nhiều cột phụ, khi quy ché thay đổi thì chỉnh sửa hơi ngại nên muốn len GPE nhờ mọi người giúp đỡ
phần này sheet khenthuong
Điều 14. Xét cho lên lớp hoặc không được lên lớp
1. Học sinh có đủ các điều kiện dưới đây [B]thì được lên lớp[/B]:
...
b) [B]Nghỉ không quá 45 buổi học trong một năm học[/B] (nghỉ có phép hoặc không phép, nghỉ liên tục hoặc nghỉ nhiều lần cộng lại).
2. Học sinh thuộc 1 trong các trường hợp dưới đây thì [B]không được lên lớp[/B]:(Lưu ban)
a) [B]Nghỉ quá 45 buổi học trong năm học[/B] (nghỉ có phép hoặc không phép, nghỉ liên tục hoặc nghỉ nhiều lần cộng lại);
...Xin cảm ơn bạn đã góp ýKhông có số ngày nghĩ làm sao xét lên lớp, ở lại, thi lại ?
Điều 14. Xét cho lên lớp hoặc không được lên lớp
1. Học sinh có đủ các điều kiện dưới đây thì được lên lớp:
...
b) Nghỉ không quá 45 buổi học trong một năm học (nghỉ có phép hoặc không phép, nghỉ liên tục hoặc nghỉ nhiều lần cộng lại).
2. Học sinh thuộc 1 trong các trường hợp dưới đây thì không được lên lớpLưu ban)
a) Nghỉ quá 45 buổi học trong năm học (nghỉ có phép hoặc không phép, nghỉ liên tục hoặc nghỉ nhiều lần cộng lại);
...
Hàm xét lên lớp, xét danh hiệu
Function XetLenLop(vang As Integer, hocluc As String, hanhkiem As String) As String
If vang > 45 Or hocluc = "Kém" Or (hocluc = "Y" And hanhkiem = "Y") Then
XetLenLop = "L" & ChrW(432) & "u ban"
ElseIf hocluc = "Y" And (hanhkiem = "G" Or hanhkiem = "K" Or hanhkiem = "TB") Then
XetLenLop = "Thi l" & ChrW(7841) & "i"
ElseIf hanhkiem = "Y" And (hocluc = "G" Or hocluc = "K" Or hocluc = "TB") Then
XetLenLop = "RLHK"
Else
XetLenLop = "Lên l" & ChrW(7899) & "p"
End If
End FunctionFunction DanhHieu(vang As Integer, hocluc As String, hanhkiem As String) As String
If vang <= 45 And (hocluc = "G" Or hocluc = "K" Or hocluc = "TB") And (hanhkiem = "T" Or hanhkiem = "K" Or hanhkiem = "TB") Then
If hocluc = "G" And hanhkiem = "T" Then
DanhHieu = "HSG"
ElseIf (hocluc = "G" Or hocluc = "K") And (hanhkiem = "T" Or hanhkiem = "K") Then
DanhHieu = "HSTT"
End If
End If
End FunctionSub LocDanhSach()
Dim cn As Object
Set cn = Sheets("Ca nam")
rc = cn.Cells(2, 1).End(xlDown).Row
Sheets("LuuBan-ThiLai-RenHK").Select
Range("B8:H17,B24:H33,B40:H49").ClearContents
rlb = 8
rtl = 24
rhk = 40
For r = 3 To rc
loai = cn.Cells(r, 22)
If loai <> "Len lop" Then
Select Case loai
Case "L" & ChrW(432) & "u ban"
Cells(rlb, 2) = rlb - 7
Cells(rlb, 3) = cn.Cells(r, 2)
rlb = rlb + 1
Case "Thi l" & ChrW(7841) & "i"
diemtb = ""
Cells(rtl, 2) = rtl - 23
Cells(rtl, 3) = cn.Cells(r, 2)
For c = 3 To 15
dtb = cn.Cells(r, c)
If dtb < 5 And dtb <> "" Then
diemtb = diemtb & cn.Cells(2, c) & " "
End If
Next
Cells(rtl, 5) = diemtb
rtl = rtl + 1
Case "RLHK"
a = 0
Cells(rhk, 2) = rhk - 39
Cells(rhk, 3) = cn.Cells(r, 2)
rhk = rhk + 1
End Select
End If
Next
End SubBạn thay đoạn code này:
Case "Thi l" & ChrW(7841) & "i"
diemtb = ""
Cells(rtl, 2) = rtl - 23
Cells(rtl, 3) = cn.Cells(r, 2)
For c = 3 To 15
dtb = cn.Cells(r, c)
If dtb < 5 And dtb <> "" Then
[COLOR=blue]diemtb = diemtb & cn.Cells(2, c) & " "[/COLOR]
End If
Next
Cells(rtl, 5) = diemtb
rtl = rtl + 1Case "Thi l" & ChrW(7841) & "i"
diemtb = ""
Cells(rtl, 2) = rtl - 23
Cells(rtl, 3) = cn.Cells(r, 2)
For c = 3 To 15
dtb = cn.Cells(r, c)
If dtb < 5 And dtb <> "" Then
[COLOR=red]diemtb = diemtb & cn.Cells(2, c) & ":" & dtb & " "
[/COLOR] End If
Next
Cells(rtl, 5) = diemtb
rtl = rtl + 1Một lần nữa cảm ơn bác rất nhiều
