Code tạo sheet dựa vào một danh sách cho trước (2 người xem)

[HADUNGNHISANG]

em có một cột gồm 173 mã sản phẩm, em cần tạo 173 worksheet cho các mã sản phẩm đó.
Vì copy từng cái một rất lâu, nên nhờ các anh chị chỉ cho em xin công thức hoặc cách làm nhanh cho việc này
Em xin gửi file đính kèm cho anh chị tham khảo.

Xin chân thành cảm ơn!

 

[Quang_Hải]

em có một cột gồm 173 mã sản phẩm, em cần tạo 173 worksheet cho các mã sản phẩm đó.
Vì copy từng cái một rất lâu, nên nhờ các anh chị chỉ cho em xin công thức hoặc cách làm nhanh cho việc này
Em xin gửi file đính kèm cho anh chị tham khảo.

Xin chân thành cảm ơn!

Copy code này vào 1 module, bấm F5 1 cái là có kết quả
Code đơn giản nhưng chỉ chạy 1 lần, chạy lần 2 phát sinh lỗi nha

Sub TaoSheet()
Dim data(), i&
data = Sheet1.Range("A2", Sheet1.[A65536].End(3)).Value
For i = 1 To UBound(data)
   Sheets.Add.Name = data(i, 1)
Next
End Sub

 

[ndu96081631]

em có một cột gồm 173 mã sản phẩm, em cần tạo 173 worksheet cho các mã sản phẩm đó.
Vì copy từng cái một rất lâu, nên nhờ các anh chị chỉ cho em xin công thức hoặc cách làm nhanh cho việc này
Em xin gửi file đính kèm cho anh chị tham khảo.

Xin chân thành cảm ơn!

Quy trình để tạo 1 sheet:
- Kiểm tra sự tồn tại của sheet
- Kiểm tra tính hợp lệ của tên sheet (vì không phải tên nào cũng được chấp nhận)
- Cuối cùng mới đến công đoạn tạo sheet
Toàn bộ code:

Function SheetExists(ByVal SheetName As String) As Boolean
  On Error Resume Next
  SheetExists = Not Sheets(SheetName) Is Nothing
End Function
Function isValidSheetName(ByVal SheetName As String) As Boolean
  If (Len(SheetName) > 31) Or (Len(SheetName) = 0) Then Exit Function
  With CreateObject("VBScript.RegExp")
    .Pattern = "[\\:\][/?*]"
    isValidSheetName = Not .Test(SheetName)
  End With
End Function
Sub CreateSheet(ByVal arrSheets As Variant)
  Dim tmpArr, Item
  On Error GoTo ErrHandler
  tmpArr = arrSheets
  If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
  For Each Item In tmpArr
    If isValidSheetName(CStr(Item)) Then
      If Not (SheetExists(CStr(Item))) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(Item)
      End If
    End If
  Next
  Exit Sub
ErrHandler: MsgBox Err.Description
End Sub
Sub Main()
  CreateSheet [COLOR=#ff0000]Sheet1.Range("A2:A200")[/COLOR]
End Sub

Xem file
Toàn bộ code bạn biết cũng được mà không biết cũng không có vấn đề gì, chỉ cần biết áp dụng, chính là thay thế chỗ màu đỏ cho phù hợp (chỗ màu đỏ là địa chỉ vùng chứa tên các sheet)

 

[TrungChinhs]

Ngày xưa mới học viết code, mình khoái nhất là code của Ndu vì ngắn và dễ hiểu. Còn bây giờ thì thấy bất lực quá, trong bài trên chỉ còn hiểu mỗi câu bẫy lỗi và Sub Main() ẹc...ẹc...

 

[ndu96081631]

Ngày xưa mới học viết code, mình khoái nhất là code của Ndu vì ngắn và dễ hiểu. Còn bây giờ thì thấy bất lực quá, trong bài trên chỉ còn hiểu mỗi câu bẫy lỗi và Sub Main() ẹc...ẹc...

Anh biết sao không? Tại vì càng lúc em càng lười. Thế nên phải cố viết được code nào đó để có thể dùng nhiều lần cho nhiều bài toán (dạng công cụ dùng chung)
Giờ cứ ai hỏi vấn đề gì, chỉ việc lục tìm trong đống công cụ (đã lưu trên máy tính), cái nào phù hợp thì mang ra ráp vào là xong. Khỏi mất công viết lại. Ẹc... Ec...

 

[VetMini]

Tới 173 sheets lận. Người chạy không thể chạy xong rồi kiểm lại cái nào có và cái nào không.
Bình thường thì người ta tạo thêm một sheet tạm, ghi lại quá trình. Đại khái:
Các sheets đã tạo ra:
SheetA, SheetB,...
Các sheets không tạo được vì tên không hợp lệ:
SheetX, SheetY,...
Các sheets không tạo được vì đã có sẵn:
SheetM, SheetN,...

 

[ndu96081631]

Tới 173 sheets lận.

Nói thật chứ trước giờ mình cũng chưa bao giờ nhìn thấy file với 173 sheets
???!!!
Chỉ nội cái vụ chuyển qua chuyển lại từ sheet này sang sheet khác chắc cũng toát mồ hôi. Rồi công thức liên kết từ sheet này sang sheet khác... nghĩ thôi cũng thấy ớn rồi
Nói xui, có ngày nào đó mà tác giả đưa nguyên file 173 sheets ấy lên hỏi (gì gì đó) chắc người ta mở ra xem và... chạy luôn chứ không thể kiên nhẫn để làm bất cứ thứ gì
Ẹc... Ẹc....

 

[Quang_Hải]

Với code bài 3 thì có thể nâng độ khó lên tí sẽ bẫy được lỗi sheet đã có rồi

Sub TaoSheet()
On Error Resume Next
Dim data(), i&
data = Sheet1.Range("A2", Sheet1.[A65536].End(3)).Value
For i = 1 To UBound(data)
   If Sheets(data(i, 1)) Is Nothing Then
      Sheets.Add.Name = data(i, 1)
   End If
Next
End Sub

Kỹ thêm chút nữa là canh chừng có ô trống ở giữa đống dữ liệu

Sub TaoSheet()
On Error Resume Next
Dim data(), i&
data = Sheet1.Range("A2", Sheet1.[A65536].End(3)).Value
For i = 1 To UBound(data)
   If data(i, 1) <> "" Then
      If Sheets(data(i, 1)) Is Nothing Then
         Sheets.Add.Name = data(i, 1)
      End If
   End If
Next
End Sub

Còn nếu muốn nhức đầu chút nữa thì bẫy tiếp những ký tự không cho phép đặt tên sheet

Sub TaoSheet()
On Error Resume Next
Dim data(), i&
data = Sheet1.Range("A2", Sheet1.[A65536].End(3)).Value
With CreateObject("VBScript.RegExp")
   .Pattern = "[\\:\][/?*]"
   For i = 1 To UBound(data)
      If data(i, 1) <> "" Then
         If Not .test(data(i, 1)) Then
            If Sheets(data(i, 1)) Is Nothing Then
               Sheets.Add.Name = data(i, 1)
            End If
         End If
      End If
   Next
End With
End Sub

 

[VetMini]

Nói thật chứ trước giờ mình cũng chưa bao giờ nhìn thấy file với 173 sheets
???!!!
...

Nói thật chứ trước giờ mình chưa bao giò nhìn thấy người hỏi mà không nhân bội con số của mình lên. 10 đưa lên câu hỏi thành 100 là chuyện thường tình.

Thêm nữa, ngược lại thì người hỏi có khuynh hướng giảm thiểu số yêu cầu. 10 yêu cầu đưa lên còn 2,3. Sau vài lượt "nhưng mà còn..." nữa mới thấy đủ 10.

 

[ndu96081631]

Với code bài 3 thì có thể nâng độ khó lên tí sẽ bẫy được lỗi sheet đã

Code bài 3 bẫy tất tần tật cả rồi còn gì?
Mà hình như là code của Hải vẫn chưa bẫy lỗi tên sheet có độ dài > 31 ký tự (và vài lỗi khác nữa)
(vì Hải dùng On Error Resume Next nên chắc chắn sẽ không nhìn thấy được mấy lỗi này)

 

[VetMini]

Code bài 3 bẫy tất tần tật cả rồi còn gì?
Mà hình như là code của Hải vẫn chưa bẫy lỗi tên sheet có độ dài > 31 ký tự (và vài lỗi khác nữa)
(vì Hải dùng On Error Resume Next nên chắc chắn sẽ không nhìn thấy được mấy lỗi này)

Trong code bài #3, hàm isValidFileName mỗi lần được gọi thì lại dựng object RegExp một lần. Nếu chay nhiều lần thì không được hiệu quả.

Để giải quyết tình trạng này, tôi thường đề nghị dùng biến static hoặc biến global.
Tuy nhiên bạn có nói rằng những hàm này bạn để giành trong thư viện, lúc cần thì lôi ra, cho nên tôi đề nghị sửa hàm dùng tham optional:

Function isValidSheetName(ByVal SheetName As String, Optional ByRef regX As Object = Nothing) As Boolean
  If (Len(SheetName) > 31) Or (Len(SheetName) = 0) Then Exit Function
  If regX Is Nothing Then Set regX = CreateObject("VBScript.RegExp")
  regX.Pattern = "[\\:\][/?*]"
  isValidSheetName = Not regX.Test(SheetName)
End Function
Sub CreateSheet(ByVal arrSheets As Variant)
  Dim tmpArr, Item
  [B][COLOR=#ff0000]Dim regX As Object[/COLOR][/B]
  On Error GoTo ErrHandler
  tmpArr = arrSheets
  If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
  For Each Item In tmpArr
    If isValidSheetName(CStr(Item)[B][COLOR=#ff0000], regX[/COLOR][/B]) Then
      If Not (SheetExists(CStr(Item))) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(Item)
      End If
    End If
  Next
  Exit Sub
ErrHandler: MsgBox Err.Description
End Sub
[B][COLOR=#008000]' nếu chỉ tạo một vài sheets thi bỏ chỗ đỏ đỏ đi
[/COLOR][/B]

 

[ndu96081631]

Trong code bài #3, hàm isValidFileName mỗi lần được gọi thì lại dựng object RegExp một lần. Nếu chay nhiều lần thì không được hiệu quả.

Khi viết những code có liên quan đến tốc độ, mình suy nghĩ kỹ lắm. Bởi vì đây là những hàm dùng cho việc tạo sheet nên chẳng thể nào chạy trên 1000 lần, đúng không? (mình cũng chưa từng thấy file 100 sheets chứ đừng nói là 1000 sheets)
Bởi vậy cái việc ảnh hưởng đến hiệu quả làm việc này nếu có cũng chẳng đáng là bao
----------------------------------------------
Dù vậy, vẫn học hỏi được ở bạn cách viết code rất chuyên nghiệp và thật lòng cảm ơn bạn chỗ này:

Tuy nhiên bạn có nói rằng những hàm này bạn để giành trong thư viện, lúc cần thì lôi ra, cho nên tôi đề nghị sửa hàm dùng tham optional:

 

[HADUNGNHISANG]

Nói thật chứ trước giờ mình cũng chưa bao giờ nhìn thấy file với 173 sheets
???!!!
Chỉ nội cái vụ chuyển qua chuyển lại từ sheet này sang sheet khác chắc cũng toát mồ hôi. Rồi công thức liên kết từ sheet này sang sheet khác... nghĩ thôi cũng thấy ớn rồi
Nói xui, có ngày nào đó mà tác giả đưa nguyên file 173 sheets ấy lên hỏi (gì gì đó) chắc người ta mở ra xem và... chạy luôn chứ không thể kiên nhẫn để làm bất cứ thứ gì
Ẹc... Ẹc....

Xin cảm ơn các anh chị!
em đã thử làm và đã thử kiểm tra lại bằng cách tập hợp các sheet lại.
rất tuyệt vời.
Thật tài giỏi! Đáng để học hỏi!