Xin hỏi về code tự động đặt tên Sheet theo một vùng dữ liệu? (1 người xem)

KUMI · 20/12/12

Xin Chào!

Trong file đính kèm ở sheet1.Em có 1 vùng dữ liệu từ A1:A7
Dùng code nào để thay tên sheet từ sheet1:sheet6 theo tên lần lượt từ trên xuống dưới trong vùng A1:A7 ạ?

Các Thầy xem và giúp đỡ em với.Xin Cám ơn!

ndu96081631 · 20/12/12

KUMI đã viết:
Xin Chào!

Trong file đính kèm ở sheet1.Em có 1 vùng dữ liệu từ A1:A7
Dùng code nào để thay tên sheet từ sheet1:sheet6 theo tên lần lượt từ trên xuống dưới trong vùng A1:A7 ạ?

Các Thầy xem và giúp đỡ em với.Xin Cám ơn!

Cho toàn bộ code dưới đây vào Module

PHP:

Function SheetExist(ByVal WshName As String) As Boolean
  On Error Resume Next
  SheetExist = Not ThisWorkbook.Sheets(WshName) Is Nothing
End Function

PHP:

Function isValidWshName(ByVal WshName As String) As Boolean
  If Len(WshName) > 31 Or Len(WshName) = 0 Then Exit Function
  With CreateObject("VBScript.RegExp")
    .Pattern = "[\\:\][/?*]"
    isValidWshName = Not .Test(WshName)
  End With
End Function

PHP:

Sub CreateSheet(ByVal WshNames As Variant)
  Dim tmpArr, Item, i As Long
  tmpArr = WshNames
  If TypeName(tmpArr) <> "Variant()" Then tmpArr = Array(tmpArr)
  For Each Item In tmpArr
    If isValidWshName(CStr(Item)) Then
      If Not (SheetExist(CStr(Item))) Then
        i = i + 1
        If i <= Sheets.Count Then
          Sheets(i).Name = CStr(Item)
        Else
          Sheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(Item)
        End If
      End If
    End If
  Next
End Sub

PHP:

Sub Main()
  CreateSheet Sheet1.Range("A1:A100")
End Sub

Chạy Sub Main sẽ có kết quả

Ba Tê · 20/12/12

KUMI đã viết:
Xin Chào!

Trong file đính kèm ở sheet1.Em có 1 vùng dữ liệu từ A1:A7
Dùng code nào để thay tên sheet từ sheet1:sheet6 theo tên lần lượt từ trên xuống dưới trong vùng A1:A7 ạ?

Các Thầy xem và giúp đỡ em với.Xin Cám ơn!

Chỉ riêng với file của bạn thì thử với code này xem.

PHP:

Public Sub GPE()
Dim Arr(), Ws As Worksheet, K As Long
Arr = Sheets("Sheet1").Range("A2:A7").Value
For Each Ws In ThisWorkbook.Worksheets
    K = K + 1
    Ws.Name = Arr(K, 1)
Next
End Sub

Sheet1 lại đặt tên Sheet1 làm gì hổng biết???

KUMI · 20/12/12

Ba Tê đã viết:
Chỉ riêng với file của bạn thì thử với code này xem.

PHP:

Public Sub GPE() Dim Arr(), Ws As Worksheet, K As Long Arr = Sheets("Sheet1").Range("A2:A7").Value For Each Ws In ThisWorkbook.Worksheets K = K + 1 Ws.Name = Arr(K, 1) Next End Sub

Sheet1 lại đặt tên Sheet1 làm gì hổng biết???

Àh đâu Em nhầm... hi hi! Sheet 1 cũng đổi tên luôn ạ...^^
Thầy chữa lại code giúp em nhé!
Cám ơn các Thầy Em sẽ tìm hiểu.

Ba Tê · 20/12/12

KUMI đã viết:
Àh đâu Em nhầm... hi hi! Sheet 1 cũng đổi tên luôn ạ...^^
Thầy chữa lại code giúp em nhé!
Cám ơn các Thầy Em sẽ tìm hiểu.

Thử lại xem sao................................

PHP:

Public Sub GPE()
Dim Arr(), Ws As Worksheet, K As Long
With Sheet1
    Arr = .Range(.[A2], .[A1000].End(xlUp)).Value
End With
For Each Ws In ThisWorkbook.Worksheets
    K = K + 1
    Ws.Name = Arr(K, 1)
Next
End Sub

KUMI · 20/12/12

Ba Tê đã viết:
Thử lại xem sao................................

PHP:

Public Sub GPE() Dim Arr(), Ws As Worksheet, K As Long With Sheet1 Arr = .Range(.[A2], .[A1000].End(xlUp)).Value End With For Each Ws In ThisWorkbook.Worksheets K = K + 1 Ws.Name = Arr(K, 1) Next End Sub

Híc! Em cám ơn Thầy nhiều, nhưng mà hình như có mỗi Sheet1 là đổi thành Xoài thôi ạ còn các sheet 2:sheet6 tên không thay đổi Thầy ạ. Thầy kiểm tra lại xem hay em chưa biết cách sử dụng code nên mới bị lỗi vậy ạ?
----
À! Em sai xin lỗi Thầy nhưng phải Run code 2 lần mới có tác dụng.

KUMI · 20/12/12

ndu96081631 đã viết:

Cho toàn bộ code dưới đây vào Module

PHP:

Function SheetExist(ByVal WshName As String) As Boolean
  On Error Resume Next
  SheetExist = Not ThisWorkbook.Sheets(WshName) Is Nothing
End Function

PHP:

Function isValidWshName(ByVal WshName As String) As Boolean
  If Len(WshName) > 31 Or Len(WshName) = 0 Then Exit Function
  With CreateObject("VBScript.RegExp")
    .Pattern = "[\\:\][/?*]"
    isValidWshName = Not .Test(WshName)
  End With
End Function

PHP:

Sub CreateSheet(ByVal WshNames As Variant)
  Dim tmpArr, Item, i As Long
  tmpArr = WshNames
  If TypeName(tmpArr) <> "Variant()" Then tmpArr = Array(tmpArr)
  For Each Item In tmpArr
    If isValidWshName(CStr(Item)) Then
      If Not (SheetExist(CStr(Item))) Then
        i = i + 1
        If i <= Sheets.Count Then
          Sheets(i).Name = CStr(Item)
        Else
          Sheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(Item)
        End If
      End If
    End If
  Next
End Sub

PHP:

Sub Main()
  CreateSheet Sheet1.Range("A1:A100")
End Sub

Chạy Sub Main sẽ có kết quả

Oh! Chuẩn quá Thầy ạ. Em cám ơn nhiều..hihihi!

Ba Tê · 20/12/12

KUMI đã viết:
Híc! Em cám ơn Thầy nhiều, nhưng mà hình như có mỗi Sheet1 là đổi thành Xoài thôi ạ còn các sheet 2:sheet6 tên không thay đổi Thầy ạ. Thầy kiểm tra lại xem hay em chưa biết cách sử dụng code nên mới bị lỗi vậy ạ?
----
À! Em sai xin lỗi Thầy nhưng phải Run code 2 lần mới có tác dụng.

Hic! Tui hổng hiểu gì hết trọi, tui "Rung" 1 phát là xong mà.
??????????

ndu96081631 · 20/12/12

KUMI đã viết:
Oh! Chuẩn quá Thầy ạ. Em cám ơn nhiều..hihihi!

Không biết bạn có test kỹ chưa, chứ với code của tôi, cho dù bạn chưa tạo sheet sẵn thì khi code chạy nó cũng sẽ tự tạo giúp bạn
Tóm lại: Bạn chỉ cần.. RUNG ĐỦI
-----------
Sở dĩ code dài thấy là phải qua nhiều công đoạn:
- Test xem tên sheet sắp đặt có chưa
- Test xem tên sheet sắp đặt có hợp lệ không (ai biết bạn hứng lên, gõ bậy bạ gì đó vào A2:A7 thì sao)
- Test xem số lượng sheet sắp đặt tên đã được tạo chưa
vân vân.. và vân vân...
Vậy đấy!

Lê Duy Thương · 20/12/12

ndu96081631 đã viết:

Cho toàn bộ code dưới đây vào Module

PHP:

Function SheetExist(ByVal WshName As String) As Boolean
  On Error Resume Next
  SheetExist = Not ThisWorkbook.Sheets(WshName) Is Nothing

End Function

PHP:

Function isValidWshName(ByVal WshName As String) As Boolean
  If Len(WshName) > 31 Or Len(WshName) = 0 Then Exit Function
  With CreateObject("VBScript.RegExp")
    .Pattern = "[\\:\][/?*]"
    isValidWshName = Not .Test(WshName)
  End With
End Function

PHP:

Sub CreateSheet(ByVal WshNames As Variant)
  Dim tmpArr, Item, i As Long
  tmpArr = WshNames
  If TypeName(tmpArr) <> "Variant()" Then tmpArr = Array(tmpArr)
  For Each Item In tmpArr
    If isValidWshName(CStr(Item)) Then
      If Not (SheetExist(CStr(Item))) Then
        i = i + 1
        If i <= Sheets.Count Then
          Sheets(i).Name = CStr(Item)
        Else
          Sheets.Add(After:=Sheets(Sheets.Count)).Name = CStr(Item)
        End If
      End If
    End If
  Next
End Sub

PHP:

Sub Main()
  CreateSheet Sheet1.Range("A1:A100")
End Sub

Chạy Sub Main sẽ có kết quả

bám vào chân các cao thủ cho vui.

PHP:

Sub Add()
Dim R As Long, ten As String
On Error Resume Next
R = 2
Do
  ten = Sheet1.Cells(R, 1)
  Sheets(ten).Select
  If Err.Number > 0 Then
    ThisWorkbook.Worksheets.Add.Name = ten
    Err.Number = 0
  End If
  R = R + 1
Loop While Sheet1.Cells(R, 1) <> ""
End Sub

KUMI · 21/12/12

ndu96081631 đã viết:
Không biết bạn có test kỹ chưa, chứ với code của tôi, cho dù bạn chưa tạo sheet sẵn thì khi code chạy nó cũng sẽ tự tạo giúp bạn
Tóm lại: Bạn chỉ cần.. RUNG ĐỦI
-----------
Sở dĩ code dài thấy là phải qua nhiều công đoạn:
- Test xem tên sheet sắp đặt có chưa
- Test xem tên sheet sắp đặt có hợp lệ không (ai biết bạn hứng lên, gõ bậy bạ gì đó vào A2:A7 thì sao)
- Test xem số lượng sheet sắp đặt tên đã được tạo chưa
vân vân.. và vân vân...
Vậy đấy!

Đúng là Em không hiểu code của Thầy có những công dụng gì. Nhưng thấy nó hay ở chỗ cái nhập bao nhiêu tên vào vùng dữ liệu thì cho ra từng đấy Sheet và theo tên của vùng dữ liệu đó.
Cũng chư kịp Rung Đùi thì code đã chạy xong rồi Thầy ạ!(thật là tuyệt).Hihi
----------------
Nhưng mà hình như máy tính của em chắc có vấn đề rồi. Em chạy file đính kèm của Thầy cũng phải Run 2 lần mới được như ý (Run lân 1 mới chỉ đổi tên được 1 sheet 1, Run lần 2 mới insert Sheet và đổi tên Sheet hix) cũng giống như lỗi bài của Thầy BaTe. Chắc la lỗi do máy tính rồi ạ.
-----------------
Em cám ơn Các Thầy nhiều nhá! ^^

ndu96081631 · 21/12/12

KUMI đã viết:
Nhưng mà hình như máy tính của em chắc có vấn đề rồi. Em chạy file đính kèm của Thầy cũng phải Run 2 lần mới được như ý (Run lân 1 mới chỉ đổi tên được 1 sheet 1, Run lần 2 mới insert Sheet và đổi tên Sheet hix) cũng giống như lỗi bài của Thầy BaTe. Chắc la lỗi do máy tính rồi ạ.

Muốn biết thế nào, hãy mang file sang máy khác mà test thì biết liền chứ gì
(Code của tôi thậm chí không có bẫy lỗi nên chuyện lỗi gì đó là không thể xãy ra rồi)

Xin hỏi về code tự động đặt tên Sheet theo một vùng dữ liệu? (1 người xem)

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

KUMI

Bụi phấn

File đính kèm

ndu96081631

Huyền thoại GPE

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

KUMI

Bụi phấn

Ba Tê

Cạo Rồi Khỏi Gội

KUMI

Bụi phấn

KUMI

Bụi phấn

Ba Tê

Cạo Rồi Khỏi Gội

ndu96081631

Huyền thoại GPE

Lê Duy Thương

Cạo lấy gì gội (Dịch quá không gội được)

KUMI

Bụi phấn

ndu96081631

Huyền thoại GPE

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

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.