Cùng đi tìm lỗi sai-vui chơi có thưởng lớn

tuhocvba

Administrator
Thành viên BQT
Đã hết hạn trả lời vấn đề 5. Không ai đưa ra được đáp án.
Đây là đoạn code mục đích để tìm dòng cuối cùng chứa dữ liệu trong cột A trên Excel. Người ta sẽ đặt con trỏ chuột vào cells cuối cùng của cột A (dòng 65536) và ấn Ctrl + . Con trỏ sẽ chạy về cells cuối cùng chứa dữ liệu trong cột A.
Tuy nhiên với Excel 2003 trở về trước thì đúng là nó có 65536 dòng.
Nhưng từ Excel 2007 trở đi, thì số dòng trong sheet sẽ là 1048 576 dòng. Vì vậy mà code trên sẽ không phù hợp để tìm cells cuối chứa dữ liệu trong cột A nếu người dùng sử dụng Excel 2007 hoặc mới hơn.

Người ta có chú ý rằng, với Excel 2007 trở đi, nếu dùng Count (đếm số dòng, có kiểu trả về là Long) có thể dẫn tới lỗi tràn số.
Do đó nên sử dụng CountLarge (có kiểu trả về là Variant).
Sau đây, giới thiệu hai đoạn code có cùng mục đích tìm cells cuối cùng chứa dữ liệu trên cột A:
Mã:
'===========================================================
' Tim dong cuoi cung tren cot A
'===========================================================
Sub LastRow()
  If Application.ActiveCell Is Nothing Then Exit Sub ' File excel đang mở mà sheet không được active thì thoát chương trình
  ' Tìm dòng cuối trên cột A
  With Application.Cells(Rows.CountLarge, 1) ' Thay vì dùng 65536 ta sử dụng Rows.CountLarge
    If .Value = "" Then
      .End(xlUp).Select ' Tương đương với việc ấn phím Ctrl + ↑ 
    Else
      .Select ' Select tới cells cuối chứa dữ liệu trên cột A
    End If
  End With
End Sub

' Nếu sử dụng Find thì ta có chương trình sau để tìm dòng cuối
Sub LastRowByFind()
  Dim r As Range

  If Application.ActiveCell Is Nothing Then Exit Sub ' File đang mở mà sheet không active thì thoát
  Set r = Columns(ActiveCell.Column).Find(What:="*", After:=Cells(1, ActiveCell.Column), LookIn:=xlValues, SearchDirection:=xlPrevious)
  If r Is Nothing Then
    Application.Cells(1, ActiveCell.Column).Select ' Select dòng đầu tiên
  Else
    r.Select
  End If
End Sub
 

tuhocvba

Administrator
Thành viên BQT
Vấn đề 6: Tìm lỗi sai trong chương trình sau.
Khái quát mục đích chương trình dưới đây: Sẽ tính tổng các số được nhập vào. Nếu ấn Cancel là kết thúc quá trình nhập.
Mã:
Option Private Module ' Module ben ngoai khong the tham chieu vao Module nay.
Option Base 1 ' Phan tu bat dau cua mang se duoc thiet dinh la 1.
Option Compare Text ' Cac phep so sanh string se khong quan tam ki tu viet hoa hay viet thuong, so sanh che do Mode Text.
'===========================================================
' Tinh tong cac so da nhap
'===========================================================
Sub SumSumple()
  ' Nhap so
  ReDim Suuji(3) As Double
  n = 1
  Do Until n > 3
    a = Application.InputBox(prompt:="So(" & CStr(n) & "):", Title:="Nhap So", Type:=1)
    If VarType(a) = vbBoolean Then Exit Do ' Se dung khi [Cancel] duoc bam
    Suuji(n) = a
    n = n + 1
  Loop
  If n < 2 Then Exit Sub ' Neu khong nhap gi thi ket thuc

  ' Tinh tong
  ReDim Preserve Suuji(n - 1) ' Khai bao lai kich thuoc mang, van giu nguyen gia tri
  Goukei = 0
  For n = LBound(Suuji) To UBound(Suuji)
    Goukei = Goukei + Suuji(n)
  Next n

  ' Hien thi ket qua
  Msg = "Tong so la " & CStr(Gokei) & " ."
  MsgBox prompt:=Msg, Buttons:=vbInformation, Title:="TongSo"
End Sub
_____
Các bạn tham khảo các vấn đề trước đây:
Vấn đề 1:
.
.
Vấn đề 2: .
.
Vấn đề 3:
.
Vấn đề 4:
.
Vấn đề 5: .
.
 

giaiphapvba

Administrator
Thành viên BQT
: Không có ai tham gia giải đáp vấn đề này.
Sai ở đây:
Mã:
Msg = "Tong so la " & CStr(Gokei) & " ."
Đúng phải là Goukei. Tuy nhiên ở trên viết là Gokei.
Các bạn nên cưỡng chế khai báo biến bằng cách viết Option Explicit ở đầu mỗi Module. Xin xem lại .

Chú ý: Số nhập vào không phải là Double. Vì chúng ta sử dụng so sánh VarType(Num) = vbBoolean , do đó hãy để kiểu biến là Variant.
Mã:
Option Explicit ' ◆ Cưỡng chế khai báo biến
Option Private Module ' Thủ tục bên ngoài module không gọi được các thủ tục trong Module này
Option Base 1 ' Chỉ số bắt đầu của mảng là 1
Option Compare Text ' Thiết định chế độ so sánh chuỗi ký tự là Text, không phân biệt in hoa hay in thường

'===========================================================
' Tinh tong cac so duoc nhap vao
'===========================================================
Sub SumSumple()
  Const csMaxCnt = 3 ' So luong input

  Dim Cnt As Integer ' so dem
  Dim Num As Variant ' So duoc nhap vao, chu y khong dung double vi chung ta su dung(VarType(Num) = vbBoolean)
  Dim Goukei As Double ' Tong so
  Dim Suuji() As Double ' Ghi vao mang cac so duoc nhap vao
  Dim Msg As String ' Noi dung thong bao

  ' Nhap vao la so
  ReDim Suuji(csMaxCnt)
  Cnt = 1
  Do Until Cnt > csMaxCnt
    Num = Application.InputBox(prompt:="So(" & CStr(Cnt) & "):", Title:="Nhap vao la So", Type:=1)
    If VarType(Num) = vbBoolean Then Exit Do ' An [Cancel] thi dung. Chu y neu de Num la Double thi khong chuyen thanh Boolean duoc
    Suuji(Cnt) = Num
    Cnt = Cnt + 1
  Loop
  If Cnt < 2 Then Exit Sub ' Neu khong nhap gi thi ket thuc

  ' Tinh tong
  ReDim Preserve Suuji(Cnt - 1) ' Khai bao lai kich thuoc mang
  Goukei = 0
  For Cnt = LBound(Suuji) To UBound(Suuji)
    Goukei = Goukei + Suuji(Cnt)
  Next Cnt

  ' Thong bao TongSo
  Msg = "Tong so la " & CStr(Goukei) & " ."
  MsgBox prompt:=Msg, Buttons:=vbInformation, Title:="Tong So"
End Sub
 

vbano1

SMod
Thành viên BQT
Topic này quả nhiên khó, vì các bạn không biết chủ đề là gì, không có gợi ý nào, nhìn vào code và phải tìm ra chỗ chưa ổn, đồng thời nêu phương án khắc phục. Tuy nhiên, mình nghĩ là nó hữu ích cho các bạn học code.

Vấn đề 7:
Mã:
Option Explicit
'===========================================================
' Van de 7
'===========================================================
Sub LongTimeProc()
  Dim Cnt As Long ' Bien đếm
  Dim tmpCalculation As XlCalculation ' Mode phương pháp tính toán
  Dim IsDisplayStatusBar As Boolean ' Lưu trạng thái của StatusBar
  Dim WaitTime As Variant ' Thời gian chờ
  Dim IsDisplayPageBreaks As Boolean  ' Vô hiệu/Cho phép hiển thị chuyển trang in

  Application.EnableEvents = False ' Vô hiệu sự kiện
  If Not Application.ActiveCell Is Nothing Then
    tmpCalculation = Application.Calculation ' Lưu Mode phương pháp tính toán
    Application.Calculation = xlCalculationManual ' Chọn Mode phương pháp tính toán bằng tay, không tính toán
    IsDisplayPageBreaks = ActiveSheet.DisplayPageBreaks 'Lưu trạng thái cho phép/vô hiệu hiển thị chuyển trang in
    ActiveSheet.DisplayPageBreaks = False ' Vô hiệu hiển thị chuyển trang in
  End If
  Application.StatusBar = "Dang thuc thi, xin cho mot chut..." ' Hien thi thong bao ra Statusbar
  IsDisplayStatusBar = Application.DisplayStatusBar ' Luu trang thai hien thi tren Statusbar
  Application.DisplayStatusBar = True ' Hien thi statusbar
  Application.Cursor = xlWait ' Con trỏ chuột đợi
  Application.ScreenUpdating = False 'Dừng cập nhật màn hình, tuy nhiên Statusbar vẫn có thể cập nhật trạng thái

  ' Bat dau qua trinh xu ly mat thoi gian --->
  For Cnt = 1 To 10
    WaitTime = Now() + TimeValue("00:00:01")
    While (Now() < WaitTime)
      DoEvents ' Khong de may tinh qua tap trung vao tinh toan, lam moi su kien neu co
    Wend
    Application.StatusBar = "Dang thuc thi, xin cho mot chut..." & String(Cnt, "■") & String(10 - Cnt, "□") ' Hien thi ra statusbar
  Next Cnt
  ' Qua trinh xu ly mat thoi gian da ket thuc <---

  Application.EnableEvents = True ' Cho phép sự kiện hoạt động
  If Not Application.ActiveCell Is Nothing Then
    Application.Calculation = tmpCalculation ' Chuyển về Mode tính toán vốn có trước đây
    ActiveSheet.DisplayPageBreaks = IsDisplayPageBreaks ' Trở lại trạng thái hiển thị chuyển trang in vốn có
  End If
  Application.StatusBar = "" ' Trả lại trạng thái StatusBar vốn có trước đây
  Application.DisplayStatusBar = IsDisplayStatusBar ' Trả lại hiển thị vốn có trên Statusbar
  Application.Cursor = xlDefault ' Trả lại giá trị con trỏ chuột
  Application.ScreenUpdating = True 'Làm mới cập nhật màn hình
End Sub
_____
Các bạn tham khảo các vấn đề trước đây:
Vấn đề 1:
.
.
Vấn đề 2: .
.
Vấn đề 3:
.
Vấn đề 4:
.
Vấn đề 5: .
.
Vấn đề 6: .
.
 

NhanSu

SMod
Thành viên BQT
Khi dùng lệnh Application.EnableEvents = False thì chương trình sẽ không nhận sự kiện nên lệnh Doevents sẽ không có tác dụng. Nếu vẫn cố tình ngắt chương trình bằng ctrl-break thì có thể dẫn đến trường hợp các thuộc tính enableevents, screenupdating ... không được phục hồi. Để khắc phục ta sửa code thành:
Mã:
Option Explicit
'===========================================================
' Van de 7
'===========================================================
Sub LongTimeProc()
  Dim Cnt As Long ' Bien d?m
  Dim tmpCalculation As XlCalculation ' Mode phuong pháp tính toán
  Dim IsDisplayStatusBar As Boolean ' Luu tr?ng thái c?a StatusBar
  Dim WaitTime As Variant ' Th?i gian ch?
  Dim IsDisplayPageBreaks As Boolean  ' Vô hi?u/Cho phép hi?n th? chuy?n trang in
  On Error GoTo Thoat
  Application.EnableCancelKey = xlErrorHandler
  Application.EnableEvents = False ' Vô hi?u s? ki?n
  If Not Application.ActiveCell Is Nothing Then
    tmpCalculation = Application.Calculation ' Luu Mode phuong pháp tính toán
    Application.Calculation = xlCalculationManual ' Ch?n Mode phuong pháp tính toán b?ng tay, không tính toán
    IsDisplayPageBreaks = ActiveSheet.DisplayPageBreaks 'Luu tr?ng thái cho phép/vô hi?u hi?n th? chuy?n trang in
    ActiveSheet.DisplayPageBreaks = False ' Vô hi?u hi?n th? chuy?n trang in
  End If
  Application.StatusBar = "Dang thuc thi, xin cho mot chut..." ' Hien thi thong bao ra Statusbar
  IsDisplayStatusBar = Application.DisplayStatusBar ' Luu trang thai hien thi tren Statusbar
  Application.DisplayStatusBar = True ' Hien thi statusbar
  Application.Cursor = xlWait ' Con tr? chu?t d?i
  Application.ScreenUpdating = False 'D?ng c?p nh?t màn hình, tuy nhiên Statusbar v?n có th? c?p nh?t tr?ng thái

  ' Bat dau qua trinh xu ly mat thoi gian --->
  For Cnt = 1 To 10
    WaitTime = Now() + TimeValue("00:00:01")
    While (Now() < WaitTime)
      'DoEvents ' Khong de may tinh qua tap trung vao tinh toan, lam moi su kien neu co
    Wend
    Application.StatusBar = "Dang thuc thi, xin cho mot chut, bam Esc de ket thuc..." & String(Cnt, "¦") & String(10 - Cnt, "?") ' Hien thi ra statusbar
  Next Cnt
  ' Qua trinh xu ly mat thoi gian da ket thuc <---
 
Thoat:
  Application.EnableEvents = True ' Cho phép s? ki?n ho?t d?ng
  Application.EnableCancelKey = xlDisabled
  If Not Application.ActiveCell Is Nothing Then
    Application.Calculation = tmpCalculation ' Chuy?n v? Mode tính toán v?n có tru?c dây
    ActiveSheet.DisplayPageBreaks = IsDisplayPageBreaks ' Tr? l?i tr?ng thái hi?n th? chuy?n trang in v?n có
  End If
  Application.StatusBar = "" ' Tr? l?i tr?ng thái StatusBar v?n có tru?c dây
  Application.DisplayStatusBar = IsDisplayStatusBar ' Tr? l?i hi?n th? v?n có trên Statusbar
  Application.Cursor = xlDefault ' Tr? l?i giá tr? con tr? chu?t
  Application.ScreenUpdating = True 'Làm m?i c?p nh?t màn hình
End Sub
 

tuhocvba

Administrator
Thành viên BQT
Khi dùng lệnh Application.EnableEvents = False thì chương trình sẽ không nhận sự kiện nên lệnh Doevents sẽ không có tác dụng.
Thời hạn các vấn đề trong topic này thường là 7 ngày kể từ ngày nêu ra vấn đề. Cảm ơn bạn NhanSu đã tham gia đóng góp ý kiến.
 

vbano1

SMod
Thành viên BQT
Lời giải của NhanSu là chính xác, khi ấn Esc đã dừng được chương trình. Ngoài bạn @NhanSu thì không có ai cho lời giải.
Nick nameLần 1Lần 2Lần 3Lần 7Tổng
bvtvba5010000150
ducdoom700500120
thanhphong8001000180
NhanSu000100100

Lời giải vấn đề 7: Khi ấn phím Esc, chương trình không dừng.
Chúng ta sẽ sử dụng lệnh On Error GoTo để bắt lỗi.
Sử dụng Application.EnableCancelKey = xlErrorHandler để khi ấn Esc sẽ phát sinh lỗi.
Mã:
Option Explicit
'===========================================================
' Xu ly mat thoi gian
'===========================================================
Sub LongTimeProc()
  Dim Cnt As Long ' Bien dem
  Dim tmpCalculation As XlCalculation ' Mode tinh toan
  Dim IsDisplayStatusBar As Boolean ' Luu trang thai statusbar
  Dim WaitTime As Variant ' Thoi gian cho
  Dim Ret As VbMsgBoxResult ' Gia tri tra ve cua MsgBox
  Dim IsDisplayPageBreaks As Boolean  ' Vo hieu/cho phep hien thi chuyen trang in

  Err.Clear ' Xoa sach loi
  On Error GoTo ErrorHandle ' Neu loi xay ra thi chay toi nhan nay
  Application.EnableEvents = False ' vo hieu hoa su kien
  If Not Application.ActiveCell Is Nothing Then
    tmpCalculation = Application.Calculation ' Luu Mode tinh toan
    Application.Calculation = xlCalculationManual ' Tinh toan bang tay
    IsDisplayPageBreaks = ActiveSheet.DisplayPageBreaks ' Luu trang thai chuyen trang in
    ActiveSheet.DisplayPageBreaks = False ' Vo hieu hoa hien thi chuyen trang in
  End If
  Application.EnableCancelKey = xlErrorHandler ' Neu an Esc thi se bat loi
  IsDisplayStatusBar = Application.DisplayStatusBar 'Luu trang thai statusbar
  Application.StatusBar = "Chuong trinh dang thuc thi...Xin cho mot chut " ' Hien thi thong bao qua statusbar
  Application.DisplayStatusBar = True ' Cho phep statusbar hien thi cho nguoi dung thay
  Application.Cursor = xlWait ' Con tro the hien dang cho
  Application.ScreenUpdating = False 'Khong cap nhat man hinh

  ' Thoi gian xu ly bat dau --->
  For Cnt = 1 To 10
    WaitTime = Now() + TimeValue("00:00:01")
    While (Now() < WaitTime)
      DoEvents ' Chuong tinh khong tap trung khi dang chay
    Wend
    Application.StatusBar = "Dang thuc thi, xin cho mot chut..." & String(Cnt, "■") & String(10 - Cnt, "□") ' Hien thi ra statusbar
  Next Cnt
  ' Ket thuc xu ly mat thoi gian <---

ErrorHandle: ' Xu ly khi co loi xay ra (Khi an Esc se tao ra loi)
  If Err.Number > 0 Then ' Co loi
    Ret = MsgBox(prompt:=Err.Description & vbNewLine & vbNewLine & "Ban muon tiep tuc chuong trinh?", Buttons:=vbExclamation + vbAbortRetryIgnore, Title:="Loi xay ra")
    If Ret = vbRetry Then Resume ' Thu tien hanh tiep
    If Ret = vbIgnore Then Resume Next ' Phot lo canh bao
    ' Truong hop dinh chi thi tiep tuc nhu duoi day
  End If
  Application.EnableEvents = True ' Cho phep su kien
  If Not Application.ActiveCell Is Nothing Then
    Application.Calculation = tmpCalculation ' Tra lai Mode tinh toan
    ActiveSheet.DisplayPageBreaks = IsDisplayPageBreaks ' Tra lai hien thi chuyen trang in nhu ban dau
  End If
  Application.StatusBar = "" 'Reset statusbar khong con gi
  Application.DisplayStatusBar = IsDisplayStatusBar ' Tra lai trang thai statusbar nhu ban dau
  Application.Cursor = xlDefault ' Tra lai con tro chuot ve che do mac dinh
  Application.EnableCancelKey = xlInterrupt ' Cho phep debug, hoac tien hanh ket thuc khi chuong trinh dang chay
  Application.ScreenUpdating = True 'Lam moi man hinh
End Sub
_____
Các bạn tham khảo các vấn đề trước đây:
Vấn đề 1:
.
.
Vấn đề 2: .
.
Vấn đề 3:
.
Vấn đề 4:
.
Vấn đề 5: .
.
Vấn đề 6: .
.
Vấn đề 7: .
Đáp án vấn đề 7.
 

PTHhn

Yêu THVBA như điếu đổ
Tôi chạy code của đáp án thấy đơ lắm. Phải bỏ Doevents đi thì ấn Esc mới được. Lời giải của tốt hơn.
 

vbano1

SMod
Thành viên BQT
@PTHhn : Vâng, lời giải của NhanSu tốt hơn lời giải đáp án. Bạn đã nhận xét đúng, tôi cũng thấy vậy.
 

tuhocvba

Administrator
Thành viên BQT
Tiếp tục cuộc đua tranh nào.
Vấn đề 8:
Mã:
Sub Upper()
  Dim r As Range

  If Application.ActiveCell Is Nothing Then Exit Sub
  If StrComp(TypeName(Selection), "Range") <> 0 Then Exit Sub
  For Each r In Selection
    r.Value = StrConv(r.Value, vbUpperCase)
  Next r
End Sub
_____
Các bạn tham khảo các vấn đề trước đây:
Vấn đề 1:
.
.
Vấn đề 2: .
.
Vấn đề 3:
.
Vấn đề 4:
.
Vấn đề 5: .
.
Vấn đề 6: .
.
Vấn đề 7: .
Đáp án vấn đề 7 và tham khảo .
 

NhanSu

SMod
Thành viên BQT
Mình thấy chương trình ở bài 8 khi chọn cả sheet thì code chạy rất lâu dẫn đến treo máy, mình có cách khắc phục nhưng thôi để bạn nào đưa code sửa lỗi lên cho vui hoặc tìm lỗi khác.
 
B

bvtvba

Guest
Tiếp tục cuộc đua tranh nào.
Vấn đề 8:
Mã:
Sub Upper()
  Dim r As Range

  If Application.ActiveCell Is Nothing Then Exit Sub
  If StrComp(TypeName(Selection), "Range") <> 0 Then Exit Sub
  For Each r In Selection
    r.Value = StrConv(r.Value, vbUpperCase)
  Next r
End Sub
Em không thấy có lỗi nào nhỉ. Hai dòng code đầu tiên đã chặn các lỗi có thể phát sinh. Nếu sheet mở ra không có cells nào được chọn thì kết thúc.
Hoặc, nếu thứ đang được select không phải là cells thì kết thúc. Các câu lệnh này là phù hợp, đảm bảo thực thi đúng ý đồ.
Vậy chỉ còn vấn đề tốc độ do phải thực thi trên cả sheet.
Một là gán vào mảng để xử lý.
Hoặc thêm để tăng tốc độ.
 

tuhocvba

Administrator
Thành viên BQT
của bvtvba là chính xác, không có lỗi gì cả, nếu các bạn muốn cải thiện tốc độ thì có thể đi theo các hướng mà bạn bvtvba đã nêu.
Nick nameLần 1Lần 2Lần 3Lần 7Lần 8Tổng
bvtvba5010000
80​
230
ducdoom700500
0​
120
thanhphong8001000
0​
180
NhanSu000100
0​
100
_____
Các bạn tham khảo các vấn đề trước đây:
Vấn đề 1:
.
.
Vấn đề 2: .
.
Vấn đề 3:
.
Vấn đề 4:
.
Vấn đề 5: .
.
Vấn đề 6: .
.
Vấn đề 7: .
Đáp án vấn đề 7 và tham khảo .
Vấn đề 8: .
Đáp án: .
 

NhanSu

SMod
Thành viên BQT
Chuơng trình tuy không có lỗi nhưng như mình đã nói ở bài trước, nếu người dùng chọn cả bảng tính thì chuơng trình sẽ xét lần lượt tất cả các ô (hơn 16 tỷ ô) và sẽ dẫn đến treo máy mặc dù số ô chứa dữ liệu thực tế nhỏ hơn rất nhiều. Điều này khiến ta nghĩ tới việc chỉ xét trên vùng chứa dữ liệu
Mã:
Intersect(Selection, ActiveSheet.UsedRange)
Tuy nhiên ta không thể gán mảng trực tiếp vào Intersect(Selection, ActiveSheet.UsedRange) vì chưa chắc đây là vùng có dạng hình chữ nhật do Selection có thể bao gồm nhiều vùng (mỗi vùng được chọn bằng cách bấm Ctrl + kéo chuột). Chúng ta xét ví dụ như hình:
Bạn cần đăng nhập để thấy đính kèm

Như hình trên ta thấy UsedRange là vùng màu xanh A3:N16. Selection là tập hợp 5 vùng màu đỏ. Vùng giao nhau của UsedRange và Selection cũng bao gồm 3 vùng. Nếu biến Vung là một range bao gồm nhiều vùng nhỏ như trên thì lệnh For each r in Vung sẽ trả về từng ô (cell) chứ không trả về từng vùng nhỏ và ta không thể tận dụng mảng để tăng tốc. Để khắc phục điều này, ta sử dụng lệnh For each r in Vung.Areas để gán từng vùng nhỏ vào biến r. Các vùng nhỏ này cần chia 2 trường hợp: nếu gồm nhiều ô thì ta gán vào mảng để xử lý, nếu có 1 ô thì không gán vào mảng được nên ta xử lý trực tiếp. Như vậy code đầy đủ trong trường hợp tổng quát sẽ là
Mã:
Sub UpperCase()
    Dim r As Range, Vung As Range, arr(), i&, j&
    Set Vung = Intersect(Selection, ActiveSheet.UsedRange)
    If Vung Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    For Each r In Vung.Areas
        If r.Count = 1 Then
            r.Value = StrConv(r.Value, vbUpperCase)
        Else
            arr = r.Value
            For i = 1 To UBound(arr)
                For j = 1 To UBound(arr, 2)
                    arr(i, j) = StrConv(arr(i, j), vbUpperCase)
                Next
            Next
            r.Value = arr
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Đính chính: trong file trên mình xét thiếu trường hợp Selection và UsedRange không giao nhau, code mình đã bổ sung trong bài viết.
 
Sửa lần cuối:

tuhocvba

Administrator
Thành viên BQT
Tiếp tục nào, vấn đề lần này là xóa các sheet rỗng (không có nội dung).
Mời các bạn tìm lỗi sai trong code dưới đây.
Vấn đề 9:
Mã:
Sub DelNoUseWorkSheet()
  Dim sh As Worksheet

  Application.DisplayAlerts = False ' Tat canh bao
  For Each sh In Worksheets
    If Application.WorksheetFunction.CountA(sh.UsedRange) = 0 Then ' Tat ca cac cells rong
      sh.Delete
    End If
  Next sh
  Application.DisplayAlerts = True ' Tra lai trang thai hien canh bao
End Sub
_____
Các bạn tham khảo các vấn đề trước đây:
Vấn đề 1:
.
.
Vấn đề 2: .
.
Vấn đề 3:
.
Vấn đề 4:
.
Vấn đề 5: .
.
Vấn đề 6: .
.
Vấn đề 7: .
Đáp án vấn đề 7 và tham khảo .
Vấn đề 8: .
Đáp án: .
 

NhanSu

SMod
Thành viên BQT
Excel phải có ít nhất 1 sheet không ẩn. Vì vậy, nếu tất cả các sheet không ẩn đều rỗng sẽ không xóa hết được và phát sinh lỗi 1004. Ngoài ra chương trình chạy khi thisworkbook không phải là activeworkbook thì sheet của workbook khác sẽ bị xóa, đây có thể không phải là điều ta mong muốn. Code sửa lại thành:
Mã:
Sub DelNoUseWorkSheet()
  Dim sh As Worksheet
  Application.DisplayAlerts = False ' Tat canh bao
  On Error Resume Next                 'Bo qua loi va tiep tuc chay khi loi
  For Each sh In ThisWorkbook.Worksheets
    If Application.WorksheetFunction.CountA(sh.UsedRange) = 0 Then ' Tat ca cac cells rong
      sh.Delete
    End If
  Next sh
  Application.DisplayAlerts = True ' Tra lai trang thai hien canh bao
End Sub
 
Sửa lần cuối:
T

thanhphong

Guest
Để xóa thì cần có ít nhất một sheet hiện, như bạn NhanSu nhận xét là đúng. Không nhất thiết phải là worksheet, một sheet bất kỳ hiện, thì mới xóa được các sheet còn lại. Về các loại sheet thì các bạn xem .
Bạn cần đăng nhập để thấy hình ảnh

Ví dụ sheet2 đang ẩn, sheet này có dữ liệu nên không xóa.
Nhưng sheet1 không có dữ liệu nên cần xóa.
Tuy nhiên không thể xóa được sheet1. Workbook cần có ít nhất 1 sheet hiện.

Ngoài ra, nếu có thêm yêu cầu, với sheet có shape, hoặc có định dạng dòng kẻ cho cells thì không xóa thì không dùng CountA để phán đoán được, cho nên dùng sh.PageSetup.Pages.Count > 0.
Bạn cần đăng nhập để thấy hình ảnh

Khi đó code sẽ như sau:
Mã:
'=============================================================================
' Dem so Worksheet dang hien tren workbook hien hanh
'=============================================================================
Function VisibleWorksheetCount() As Long
  Dim sh As Worksheet

  VisibleWorksheetCount = 0
  If Workbooks.Count < 1 Then Exit Function
  For Each sh In Worksheets
    If sh.Visible = xlSheetVisible Then VisibleWorksheetCount = VisibleWorksheetCount + 1
  Next sh
End Function

'=============================================================================
' Dem so sheet dang hien tren workbook hien hanh
'=============================================================================
Function VisibleSheetCount() As Long
  Dim sh As Object

  VisibleSheetCount = 0
  If Workbooks.Count < 1 Then Exit Function
  For Each sh In Sheets
    If sh.Visible = xlSheetVisible Then VisibleSheetCount = VisibleSheetCount + 1
  Next sh
End Function

'=============================================================================
' Xoa cac worksheet trong tren workbook hien hanh
'=============================================================================
Sub DelNoUseWorkSheet()
  Dim sh As Worksheet

  Application.DisplayAlerts = False ' Tat cap nhat man hinh
  For Each sh In Worksheets
    If Application.WorksheetFunction.CountA(sh.UsedRange) = 0 Then ' Tat ca cac cells trong sheet deu la rong
      If (sh.Visible = xlSheetVisible) And (VisibleSheetCount() < 2) Then Exit For ' Can co it nhat mot sheet dang hien
      If sh.PageSetup.Pages.Count = 0 Then sh.Delete ' Xoa worksheet
    End If
  Next sh
  Application.DisplayAlerts = True ' Cap nhat man hinh
End Sub
Nếu với yêu cầu ban đầu thì không cần dùng sh.PageSetup.Pages.Count, khi đó dòng code 37 bỏ đi điều kiện, sửa thành:
Mã:
sh.Delete
 
Sửa lần cuối bởi điều hành viên:

tuhocvba

Administrator
Thành viên BQT
Ý kiến của NhanSuthanhphong là đúng , vấn đề mấu chốt là file Excel phải có tối thiểu một sheet không ở trạng thái ẩn. Vì vậy khi thực hiện xóa sheet phải đảm bảo điều kiện này. Do NhanSu đưa ra ý kiến trước nên có số điểm 70, thanhphong mặc dù đưa ra ý kiến đầy đủ hơn nhưng nêu ý kiến chậm hơn nên số điểm là 50.
Nick nameLần 1Lần 2Lần 3Lần 7Lần 8Lần 9Tổng
bvtvba5010000
80​
0230
ducdoom700500
0​
0120
thanhphong8001000
0​
50230
NhanSu000100
0​
70170
_____
Các bạn tham khảo các vấn đề trước đây:
Vấn đề 1:
.
.
Vấn đề 2: .
.
Vấn đề 3:
.
Vấn đề 4:
.
Vấn đề 5: .
.
Vấn đề 6: .
.
Vấn đề 7: .
Đáp án vấn đề 7 và tham khảo .
Vấn đề 8: .
Đáp án: .
Vấn đề 9: .
Đáp án: .
 
Top