Giúp code: kiểm tra tên sheet có tồn tại không? so với 1 cột có tên sheet cho trước! (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Hong.Van

Busy
Tham gia
7/5/12
Bài viết
2,328
Được thích
1,765
Em chào Thầy cô & anh chị!

Tại Sheet "TH", bắt đầu từ cell C9 trở xuống có chứa tên các sheet, bây giờ dựa vào cột này kiểm tra xem trong File này có đủ tên các sheet chưa? Nếu chưa thì hiện MsgBox thông báo tên các sheet còn thiếu đồng thời thóat code.

Trong cột C của sheet TH của em có tên 13 Sheet: T01, T02, T03, T04, T05, T06, T07, T08, T11, T12, T13

Trong File của em hiện có các sheet: TH, T01, T03, T04, T10, TaoLao

Như vậy so sánh với cột C của Sheet TH thì sẽ thiếu các sheet: T02, T05, T06, T07, T08, T11, T12, T13

Em cảm ơn!
 

File đính kèm

Upvote 0
Thêm 1 tham khảo cho bạn:

PHP:
Option Explicit
Sub LietKe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 
 Set Rng = Range([C8], [C999].End(xlUp))
 For Each Sh In ThisWorkbook.Worksheets
    Set sRng = Rng.Find(Sh.Name, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        [C65500].End(xlUp).Offset(2).Value = Sh.Name
    End If
 Next Sh
End Sub
 
Upvote 0
PHP:
Option Explicit
Sub LietKe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 
 Set Rng = Range([C8], [C999].End(xlUp))
 For Each Sh In ThisWorkbook.Worksheets
    Set sRng = Rng.Find(Sh.Name, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
        [C65500].End(xlUp).Offset(2).Value = Sh.Name
    End If
 Next Sh
End Sub
Cảm ơn bạn
Mình ở đây muốn sau khi kiểm tra nó thông báo " các sheet T02, T05, T06, T07, T08, T11, T12, T13
chưa tồn tại"
 
Upvote 0
Cảm ơn bạn
Mình ở đây muốn sau khi kiểm tra nó thông báo " các sheet T02, T05, T06, T07, T08, T11, T12, T13
chưa tồn tại"
Hổng biết thông báo ở đâu, cho nó vào cột M nhé!
PHP:
Public Sub GPE()
Dim Ws As Worksheet, Dic As Object, Dic2 As Object, Rng(), Arr(1 To 65000, 1 To 1), I As Long, K As Long, Tem
Set Dic = CreateObject("Scripting.Dictionary")
Set Dic2 = CreateObject("Scripting.Dictionary")
For Each Ws In Worksheets
    If Ws.Name <> "TH" Then
        Tem = Ws.Name
        Dic.Add (Ws.Name), ""
    End If
Next
With Sheets("TH")
    Rng = .Range(.[C9], .[C65000].End(xlUp)).Value
    For I = 1 To UBound(Rng, 1)
        Tem = Rng(I, 1)
        If Not Dic.Exists(Tem) Then
            Dic.Add Tem, ""
            K = K + 1
            Arr(K, 1) = Rng(I, 1)
        End If
    Next I
    .[M1].Resize(K).Value = Arr
End With
End Sub
 
Upvote 0
Em chỉ muốn Hiện MsgBox " Cac Sheet nay chua ton tai:T02, T05, T06, T07, T08, T11, T12, T13"
Không cần thông báo ở cột M
Vậy cần code chỗ nào vậy Thầy
Em cảm ơn!
 
Upvote 0
Em chỉ muốn Hiện MsgBox " Cac Sheet nay chua ton tai:T02, T05, T06, T07, T08, T11, T12, T13"
Không cần thông báo ở cột M
Vậy cần code chỗ nào vậy Thầy
Em cảm ơn!
Chịu khó đọc code của anh Bate và edit lại tí xíu sẽ có thông báo như ý. (Trong code này anh Bate xài sang quá). Cố lên chứ. Lúc trước mình cũng phải ngồi mò mẫm thử từng dòng lệnh giờ mới có tí kinh nghiệm. Bạn thấy đó, giờ có bài nào mà mình sợ đâu. Nếu khó quá thì... bỏ chạy thế thôi.
 
Upvote 0
Em chỉ muốn Hiện MsgBox " Cac Sheet nay chua ton tai:T02, T05, T06, T07, T08, T11, T12, T13"
Không cần thông báo ở cột M
Vậy cần code chỗ nào vậy Thầy
Em cảm ơn!
Thử lại với code này xem:
PHP:
Public Sub GPE()
        Dim Ws As Worksheet, Dic As Object, Dic2 As Object, Rng(), KQ As String, I As Long, K As Long, Tem
        Set Dic = CreateObject("Scripting.Dictionary")
        Set Dic2 = CreateObject("Scripting.Dictionary")
        For Each Ws In Worksheets
            If Ws.Name <> "TH" Then
                Tem = Ws.Name
                Dic.Add (Ws.Name), ""
            End If
        Next
        With Sheets("TH")
            Rng = .Range(.[C9], .[C65000].End(xlUp)).Value
            For I = 1 To UBound(Rng, 1)
                Tem = Rng(I, 1)
                If Not Dic.Exists(Tem) Then
                    Dic.Add Tem, ""
                    K = K + 1
                    KQ = KQ & Tem & "-"
                End If
            Next I
            MsgBox "Cac sheet nay chua ton tai: " & ChrW(10) & Left(KQ, Len(KQ) - 1), , "HONG.VAN"
        End With
        End Sub
---------------
Chịu khó đọc code của anh Bate và edit lại tí xíu sẽ có thông báo như ý. (Trong code này anh Bate xài sang quá). Cố lên chứ. Lúc trước mình cũng phải ngồi mò mẫm thử từng dòng lệnh giờ mới có tí kinh nghiệm. Bạn thấy đó, giờ có bài nào mà mình sợ đâu. Nếu khó quá thì... bỏ chạy thế thôi.
Mà cái Dic2 "lãng nhách" thiệt há!
Lúc đầu định làm kiểu gì đó, thấy "dư dư" nên làm lại, mấy cái biến cũ "nằm chơi thấy ghét". Híc!
 
Lần chỉnh sửa cuối:
Upvote 0
Chịu khó đọc code của anh Bate và edit lại tí xíu sẽ có thông báo như ý. (Trong code này anh Bate xài sang quá). Cố lên chứ. Lúc trước mình cũng phải ngồi mò mẫm thử từng dòng lệnh giờ mới có tí kinh nghiệm. Bạn thấy đó, giờ có bài nào mà mình sợ đâu. Nếu khó quá thì... bỏ chạy thế thôi.

Hi, em có edit rồi nhưng nó KHÔNG CHỊU CHẠY & Báo lỗi tùm lum luôn!
 
Upvote 0
Hi, em có edit rồi nhưng nó KHÔNG CHỊU CHẠY & Báo lỗi tùm lum luôn!

Cho code dưới đây vào Module
PHP:
Function SheetExist(wksName As String) As Boolean
  On Error Resume Next
  SheetExist = Not Sheets(wksName) Is Nothing
End Function
Cho code dưới đây vào Sheet TH
PHP:
Private Sub Worksheet_Activate()
  Dim rng As Range, rCel As Range
  Dim tmp As String
  Dim bChk As Boolean
  Set rng = Range("C9:C30")
  tmp = Chr(1)
  For Each rCel In rng
    bChk = SheetExist(rCel.Value)
    If bChk = False And Len(rCel.Value) Then
      If InStr(1, tmp, Chr(1) & rCel.Value & Chr(1)) = 0 Then
        tmp = tmp & rCel.Value & Chr(1)
      End If
    End If
  Next
  tmp = Replace(tmp, Chr(1), vbLf)
  If Len(tmp) >1 Then MsgBox tmp
End Sub
Chỉ cần chọn Sheet TH thì code tự động chạy
--------------------------------------------------
Hỏi thêm: Bạn muốn là 1 "cuộc kiểm tra" này để làm gì vậy?
 
Lần chỉnh sửa cuối:
Upvote 0
Sửa code của bác Chanh theo kiểu hiện Msgbox để thông báo 1 chuyện khác: sheet T10 đã có nhưng chưa liệt kê trên sheet:
PHP:
Sub LietKe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range
 
 Set Rng = Range([C8], [C999].End(xlUp))
 For Each Sh In ThisWorkbook.Worksheets
    Set sRng = Rng.Find(Sh.Name, , xlFormulas, xlWhole)
    If sRng Is Nothing Then
       KQ = KQ & Sh.Name & "-"
    End If
 Next Sh
  MsgBox "Cac sheet nay chua liet ke: " & ChrW(10) & Left(KQ, Len(KQ) - 1), , "HONG.VAN" 

End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Chỉ cần chọn Sheet TH thì code tự động chạy
--------------------------------------------------
Hỏi thêm: Bạn muốn là 1 "cuộc kiểm tra" này để làm gì vậy?
Em có đọan code lấy kết quả tại Sheet TH, code này dựa vào cột C (có tên các sheet liên quan) để nó lấy số liệu ở các sheet này, nếu sheet nào chưa nó thì bị báo lỗi (bằng thông báo MsgBox) đồng thời thóat code, ngược lại thì tiếp tục chạy code!
-------------
Em cảm ơn Các Thầy cô & anh chị.
 
Lần chỉnh sửa cuối:
Upvote 0
Em có đọan code lấy kết quả tại Sheet TH, code này dựa vào cột C (có tên các sheet liên quan) để nó lấy số liệu ở các sheet này, nếu sheet nào chưa có thì bị báo lỗi (bằng thông báo MsgBox) đồng thời thóat code, ngược lại thì tiếp tục chạy code!
Không biết code đó là gì, nhưng bất kỳ code nào lấy dữ liệu từ sheet không tồn tại cũng đều báo lỗi. Vậy ta bẫy chính lỗi đó là được chứ gì?

Thí dụ với Function SheetExist của ndu, bẫy lỗi như sau, có thể chạy tiếp hoặc thoát tùy ý:

PHP:
For each Cll in Range("C10:C50")
   If SheetExist(Cll.Value) Then
      ... Code lấy dữ liệu
   Else
      Msgbox "Sheet " & Cll.Value & " khong ton tai"
      ' Exit Sub     'neu muon thoat
  End If
Next
 
Upvote 0
Không biết code đó là gì, nhưng bất kỳ code nào lấy dữ liệu từ sheet không tồn tại cũng đều báo lỗi. Vậy ta bẫy chính lỗi đó là được chứ gì?

Thí dụ với Function SheetExist của ndu, bẫy lỗi như sau, có thể chạy tiếp hoặc thoát tùy ý:

PHP:
For each Cll in Range("C10:C50")
   If SheetExist(Cll.Value) Then
      ... Code lấy dữ liệu
   Else
      Msgbox "Sheet " & Cll.Value & " khong ton tai"
      ' Exit Sub     'neu muon thoat
  End If
Next
Cho em hỏi:
Cột C của em có thể lên đến vài ngàn dòng, nhưng chỉ kiểm tra sự tồn tại tối đa của 12 sheet là: T01, T02, ... T11, T12 (nhưng không fải lúc nào cột C cũng có đủ 12 sheet nói trên mà có thể lúc đầu cột C chỉ có T01; T02, rồi từ từ mới thêm T03, T04 ...). Các sheet này được xếp theo thứ tự trên cột C, ví dụ: trong khối cell C9:C120 là T01; C121:C300 là T02, như vậy em dùng code trên của thầy ptm0412 và code dưới đây thì code nào có tốc độ nhanh hơn?
PHP:
Sub KT_1()
  Dim rng As Range, rCel As Range
  Dim tmp As String
  Dim bChk As Boolean
  Set rng = Range("C9:C30")
  tmp = Chr(1)
  For Each rCel In rng
    bChk = SheetExist(rCel.Value)
    If bChk = False And Len(rCel.Value) Then
      If InStr(1, tmp, Chr(1) & rCel.Value & Chr(1)) = 0 Then
        tmp = tmp & rCel.Value & Chr(1)
      End If
    End If
  Next
  tmp = Replace(tmp, Chr(1), vbLf)
  If Len(tmp) > 1 Then
  MsgBox "Sheet " & tmp & " khong ton tai"
    Exit Sub
 Else
  '... Code lay du lieu
  End If
End Sub
Em cảm ơn!
 
Upvote 0
Cho em hỏi:
Cột C của em có thể lên đến vài ngàn dòng, nhưng chỉ kiểm tra sự tồn tại tối đa của 12 sheet là: T01, T02, ... T11, T12 (nhưng không fải lúc nào cột C cũng có đủ 12 sheet nói trên mà có thể lúc đầu cột C chỉ có T01; T02, rồi từ từ mới thêm T03, T04 ...). Các sheet này được xếp theo thứ tự trên cột C, ví dụ: trong khối cell C9:C120 là T01; C121:C300 là T02, như vậy em dùng code trên của thầy ptm0412 và code dưới đây thì code nào có tốc độ nhanh hơn?
PHP:
Sub KT_1()
  Dim rng As Range, rCel As Range
  Dim tmp As String
  Dim bChk As Boolean
  Set rng = Range("C9:C30")
  tmp = Chr(1)
  For Each rCel In rng
    bChk = SheetExist(rCel.Value)
    If bChk = False And Len(rCel.Value) Then
      If InStr(1, tmp, Chr(1) & rCel.Value & Chr(1)) = 0 Then
        tmp = tmp & rCel.Value & Chr(1)
      End If
    End If
  Next
  tmp = Replace(tmp, Chr(1), vbLf)
  If Len(tmp) > 1 Then
  MsgBox "Sheet " & tmp & " khong ton tai"
    Exit Sub
 Else
  '... Code lay du lieu
  End If
End Sub
Em cảm ơn!
Vì dữ liệu vài ngàn dòng nên điều đương nhiên là vòng lập duyệt theo cell sẽ chậm ---> Sửa thành mảng là xong:
Mã:
Sub KT_1()
  [COLOR=#ff0000]Dim aSrc, Item[/COLOR]
  Dim tmp As String
  Dim bChk As Boolean
  [COLOR=#ff0000]aSrc = Range("C9:C10000").Value[/COLOR]
  tmp = Chr(1)
  For Each [COLOR=#ff0000]Item [/COLOR]In[COLOR=#ff0000] aSrc[/COLOR]
   [COLOR=#ff0000] If Len(CStr(Item)) Then[/COLOR]
      bChk = SheetExist([COLOR=#ff0000]CStr(Item)[/COLOR])
      If bChk = False Then
        If InStr(1, tmp, Chr(1) & [COLOR=#ff0000]Item[/COLOR] & Chr(1)) = 0 Then
          tmp = tmp &[COLOR=#ff0000] Item[/COLOR] & Chr(1)
        End If
      End If
    [COLOR=#ff0000]End If[/COLOR]
  Next
  tmp = Replace(tmp, Chr(1), vbLf)
  If Len(tmp) > 1 Then
  MsgBox "Sheet " & tmp & " khong ton tai"
    Exit Sub
 Else
  '... Code lay du lieu
  End If
End Sub
Chổ màu đỏ là những chổ đã sửa lại
 
Upvote 0
Tôi không hiểu đoạn code sau đây để làm gì:

Mã:
[/COLOR][COLOR=#000000][COLOR=#007700]If [/COLOR][COLOR=#0000BB]bChk [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]False [/COLOR][COLOR=#007700]And [/COLOR][COLOR=#0000BB]Len[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]rCel[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Value[/COLOR][COLOR=#007700]) [/COLOR][COLOR=#0000BB]Then
      [/COLOR][COLOR=#007700]If [/COLOR][COLOR=#0000BB]InStr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]tmp[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]Chr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700]) & [/COLOR][COLOR=#0000BB]rCel[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Value [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]Chr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700])) = [/COLOR][COLOR=#0000BB]0 Then
        tmp [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]tmp [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]rCel[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000BB]Value [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]Chr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700])
      [/COLOR][COLOR=#0000BB]End [/COLOR][COLOR=#007700]If
    [/COLOR][COLOR=#0000BB]End [/COLOR][COLOR=#007700]If[/COLOR][/COLOR]
(Next)

[COLOR=#000000][COLOR=#0000BB]  tmp [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000BB]Replace[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]tmp[/COLOR][COLOR=#007700], [/COLOR][COLOR=#0000BB]Chr[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]1[/COLOR][COLOR=#007700]), [/COLOR][COLOR=#0000BB]vbLf[/COLOR][COLOR=#007700])
  If [/COLOR][COLOR=#0000BB]Len[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000BB]tmp[/COLOR][COLOR=#007700]) > [/COLOR][COLOR=#0000BB]1 Then
[/COLOR][/COLOR][COLOR=#000000][COLOR=#0000BB]  MsgBox [/COLOR][COLOR=#DD0000]"Sheet " [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#0000BB]tmp [/COLOR][COLOR=#007700]& [/COLOR][COLOR=#DD0000]" khong ton tai"[/COLOR][/COLOR]


bChk = False tức là sheet không tồn tại rồi, còn phải xét thêm cái gì nữa?
 
Upvote 0
Theo suy luận của tôi, code lấy dữ liệu từ các sheets tồn tại dựa vào 1 danh sách sheet, nếu gặp cell chứa tên sheet không tồn tại mà thoát, tức là sẽ có nguy cơ code đã chạy lở dở được 1 số sheet rồi. Và cũng có thể đã gán 1 vài kết quả vào sheet TH rồi.
Vậy tại sao không cho chạy nốt tất cả các sheet tồn tại? Dù gì sheet không tồn tại thì cũng chẳng có dữ liệu gì để lấy, thì cứ lấy cho hết những gì đang có đi?
 
Upvote 0
Xin lỗi các anh, em chen ngang 1 chút.
Theo em thì có thể bỏ luôn cả hàm kiểm tra đi và ta dùng luôn cái mã lỗi gán sheet không có để điều khiển luôn. Em không hiểu HongVan định làm gì, nhưng thôi thì cứ cho tạm là lấy địa chỉ vùng dữ liệu đi (UsedRange) đi.Tại Sheet1 từ A1 đến A10 là tên Sheet, em sẽ lấy địa chỉ dữ liệu nếu có Sheet hoặc báo chưa có sheet vào cột B. Vậy thì em có Code thế này các anh kiểm tra giúp và cho ý kiến với
Mã:
Option Explicit
Sub GetData()
Dim Tm1, i, Sh As Worksheet
On Error Resume Next
Tm1 = Sheet1.[A1:B10]
For i = 1 To UBound(Tm1,1)
Set Sh = ThisWorkbook.Worksheets(Tm1(i, 1))
If Err.Number = 0 Then
Tm1(i, 2) = "Nhan Data tai dia chi : " & Tm1(i, 1) & "!" & Sh.UsedRange.Address
ElseIf Err.Number = 9 Then
Tm1(i, 2) = "Chua co Sheet nay."
Else
Tm1(i, 2) = "Kiem tra loi doi voi sheet nay"
End If
Err.Clear
Next
Sheet1.[A1:B10] = Tm1
End Sub

Sau này, ta thay code su lý dữ liệu hoặc lênh gọi sub sử lý vào đoạn If đầu tiên là được
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Theo suy luận của tôi, code lấy dữ liệu từ các sheets tồn tại dựa vào 1 danh sách sheet, nếu gặp cell chứa tên sheet không tồn tại mà thoát, tức là sẽ có nguy cơ code đã chạy lở dở được 1 số sheet rồi. Và cũng có thể đã gán 1 vài kết quả vào sheet TH rồi.
Vậy tại sao không cho chạy nốt tất cả các sheet tồn tại? Dù gì sheet không tồn tại thì cũng chẳng có dữ liệu gì để lấy, thì cứ lấy cho hết những gì đang có đi?
Em xin lấy File để giải thích
Em có viết code (dạng công thức) : Tại Sheet TH, dùng cột K (Mã hàng hoá) & cột C (Tên sheet) ở các dòng tương ứng, sẽ dò qua cột B (Mã hàng hoá) của các Sheet T01, T02 ... để lấy kết qủa cột "ĐGBQ" (cột J) tại các dòng tương ứng. Tại cột Q của Sheet TH sẽ lấy kết quả dò được nhân với cột P tại dòng tương ứng để cho kết quả cuối cùng

Như vậy, Tại cột C của Sheet TH giả sử đã có T03, nhưng em quên tạo Sheet T03 thì khi chạy code nó sẽ báo lỗi #REF!
Em cảm ơn
-----------------
P/s: chủ đề này có liên quan đến 1 phần đến chủ đề dưới
http://www.giaiphapexcel.com/forum/...hợp-và-Sheet-có-liên-quan&p=458106#post458106
 

File đính kèm

Upvote 0
Em xin lấy File để giải thích
Em có viết code (dạng công thức) : Tại Sheet TH, dùng cột K (Mã hàng hoá) & cột C (Tên sheet) ở các dòng tương ứng, sẽ dò qua cột B (Mã hàng hoá) của các Sheet T01, T02 ... để lấy kết qủa cột "ĐGBQ" (cột J) tại các dòng tương ứng. Tại cột Q của Sheet TH sẽ lấy kết quả dò được nhân với cột P tại dòng tương ứng để cho kết quả cuối cùng

Như vậy, Tại cột C của Sheet TH giả sử đã có T03, nhưng em quên tạo Sheet T03 thì khi chạy code nó sẽ báo lỗi #REF!
Em cảm ơn
-----------------
P/s: chủ đề này có liên quan đến 1 phần đến chủ đề dưới
http://www.giaiphapexcel.com/forum/...hợp-và-Sheet-có-liên-quan&p=458106#post458106
Vậy thì cũng đâu có gì khó:
- Tại sheet TH, ta dùng vòng lập duyệt từ trên xuống dưới theo cột C (tên sheet)
- Nếu kiểm tra thấy tên sheet tồn tại (bằng hàm SheetExist) thì tiếp tục lấy mã hàng (tại dòng tương ứng) tra vào sheet (cột C) để tìm dữ liệu ĐGBQ
- Nếu kiểm tra thấy tên sheet không tồn tại thì vòng lập bỏ qua công đoạn tra cứu rồi lại đi tiếp
------------
Thế thôi! Tôi thấy đơn giản mà
Ngoài ra, nếu code lấy dữ liệu là 1 Function thì bạn vẫn có thể bẫy lỗi mà ---> Mà tôi nghĩ nếu code là 1 UDF thì thà tôi viết công thức thường cho rồi
 
Upvote 0

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

Back
Top Bottom