Đặt tên sheet theo số thứ tự

[tam8678]

Tôi có vấn đề này mong các anh em GPE xem và giúp. Ví dụ tôi 1 sheet A, sau khi Add sheet, tôi muốn đặt tên cho sheet mới là A1 và tiếp tục là A2, A3... thì code được viết như thế nào. Xin cám ơn trước (Không biết hỏi như thế có đúng không?)

 

[ndu96081631]

Tôi có vấn đề này mong các anh em GPE xem và giúp. Ví dụ tôi 1 sheet A, sau khi Add sheet, tôi muốn đặt tên cho sheet mới là A1 và tiếp tục là A2, A3... thì code được viết như thế nào. Xin cám ơn trước (Không biết hỏi như thế có đúng không?)

Em hỏi lại: Trong Workbook của anh có nhiều sheet hay chỉ có duy nhất 1 sheet tên là A?

 

[tam8678]

Em hỏi lại: Trong Workbook của anh có nhiều sheet hay chỉ có duy nhất 1 sheet tên là A?

---
Cám ơn chú, trong Workbook có nhiều sheet.

 

[ndu96081631]

---
Cám ơn chú, trong Workbook có nhiều sheet.

Anh thử code này:

Sub InsertSheet()
  Dim Sh As Worksheet, i As Long
  Const ShName = "A"
  On Error Resume Next
  Set Sh = Sheets(ShName)
  If Not Sh Is Nothing Then
    Do
      i = i + 1
    Loop Until Sheets(ShName & i) Is Nothing
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = ShName & i
  End If
End Sub

Code này sẽ hoạt động trong trường hợp có tìm thấy sheet tên là A
Vậy anh muốn đánh STT theo 1 tên sheet nào đó, chỉ việc sửa đoạn Const ShName = "A" thành cái gì khác tùy ý

 

[tam8678]

Anh thử code này:

Sub InsertSheet()
Dim Sh As Worksheet, i As Long
Const ShName = "A"
On Error Resume Next
Set Sh = Sheets(ShName)
If Not Sh Is Nothing Then
Do
i = i + 1
Loop Until Sheets(ShName & i) Is Nothing
Sheets.Add(After:=Sheets(Sheets.Count)).Name = ShName & i
End If
End Sub

Code này sẽ hoạt động trong trường hợp có tìm thấy sheet tên là A
Vậy anh muốn đánh STT theo 1 tên sheet nào đó, chỉ việc sửa đoạn Const ShName = "A" thành cái gì khác tùy ý

---
Anh viết lung tung như thế này, nhờ chú xem, code chỉ đúng được 1 lần, lần thứ 2 thì lỗi.
(Anh sẽ test code của chú, khó nuốt ). File đính kèm.

 

[ndu96081631]

---
Anh viết lung tung như thế này, nhờ chú xem, code chỉ đúng được 1 lần, lần thứ 2 thì lỗi.
(Anh sẽ test code của chú, khó nuốt ). File đính kèm.

Chuyển code của anh thành Function

Private Function InsertSheet(ShName As String) As Worksheet
  Dim Sh As Worksheet, i As Long, Tmp As Worksheet
  On Error Resume Next
  Set Sh = Sheets(ShName)
  If Not Sh Is Nothing Then
    Do
      i = i + 1
    Loop Until Sheets(ShName & i) Is Nothing
    Set Tmp = Sheets.Add(After:=Sheets(Sheets.Count))
    Tmp.Name = ShName & i
    Set InsertSheet = Tmp
  End If
End Function

Sửa code của anh thành:

Sub AAA_UngLuong()
  On Error GoTo ExitSub
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  With InsertSheet("UngLuong-CnV")
    Sheets("UngLuong-CnV").Cells.Copy .[A1]
    .DrawingObjects.Delete
    .Tab.ColorIndex = 8
    .Range("A7:G1000").Value = Sheets("UngLuong-CnV").Range("A7:G1000").Value
    .Range(.[A10], .[A500]).Resize(, 7).Borders.LineStyle = 0
    .Range(.[A10], .[A500].End(xlUp)).Resize(, 7).Borders.LineStyle = 1
    .Range(.[A10], .[A500].End(xlUp)).Resize(, 7).Borders(xlInsideHorizontal).Weight = 1
    .Range("C1").Value = "Baïn haõy xöû duïng sheet naøy ñeå chænh trang in vaø Löu döõ lieäu - 05.04.2011"
  End With
  Sheets("UngLuong-CnV").Activate
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
ExitSub:
End Sub

 

[ndu96081631]

Em rút gọn lại code tí, không copy cells mà dùng copy sheet và bỏ luôn Function

Sub AAA_UngLuong()
  On Error Resume Next
  Const ShName = "UngLuong-CnV"
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Sheets(ShName).Copy After:=Sheets(Sheets.Count)
  With ActiveSheet
    Do
      i = i + 1
    Loop Until Sheets(ShName & i) Is Nothing
    .Name = ShName & i
    .DrawingObjects.Delete
    .Tab.ColorIndex = 8
    With .Range(.[A10], .[A500].End(xlUp)).Resize(, 7)
      .Borders.LineStyle = 0
      .Borders.LineStyle = 1
      .Borders(xlInsideHorizontal).Weight = 1
    End With
    .Range("C1").Value = "Baïn haõy xöû duïng sheet naøy ñeå chænh trang in vaø Löu döõ lieäu - 05.04.2011"
  End With
  Sheets(ShName).Activate
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

 

[tam8678]

Em rút gọn lại code tí, không copy cells mà dùng copy sheet và bỏ luôn Function

Sub AAA_UngLuong()
On Error Resume Next
Const ShName = "UngLuong-CnV"
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets(ShName).Copy After:=Sheets(Sheets.Count)
With ActiveSheet
Do
i = i + 1
Loop Until Sheets(ShName & i) Is Nothing
.Name = ShName & i
.DrawingObjects.Delete
.Tab.ColorIndex = 8
With .Range(.[A10], .[A500].End(xlUp)).Resize(, 7)
.Borders.LineStyle = 0
.Borders.LineStyle = 1
.Borders(xlInsideHorizontal).Weight = 1
End With
.Range("C1").Value = "Baïn haõy xöû duïng sheet naøy ñeå chænh trang in vaø Löu döõ lieäu - 05.04.2011"
End With
Sheets(ShName).Activate
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

---
Hết sức trân trọng sự nhiệt tình của chú, chú để anh có thời gian tiêu hóa . Chú có thể giải thích rỏ chổ này nhé

With ActiveSheet
Do
i = i + 1
Loop Until Sheets(ShName & i) Is Nothing
End With
End Sub

 

[huuthang_bd]

---
Hết sức trân trọng sự nhiệt tình của chú, chú để anh có thời gian tiêu hóa . Chú có thể giải thích rỏ chổ này nhé

With ActiveSheet
Do
i = i + 1
Loop Until Sheets(ShName & i) Is Nothing
End With
End Sub

Anh thêm dòng này vào sau vòng lặp Do... Loop kết quả sẽ đẹp hơn một tí

.Move After:=Sheets(ShName & IIf(i = 1, "", (i - 1)))

Công dụng: Sheet mới được copy sẽ nằm ngay sau Sheet nhỏ hơn liền kề nó. Thứ tự các Sheet sẽ không bị rối nếu file của anh có nhiều Sheet.

Còn một vấn đề nữa: Nếu file của anh đã có Sheet A1 và A3. Khi chạy code này Sheet mới sẽ có tên là A2. Nếu anh muốn Sheet mới là A4 thì phải viết lại code theo một thuật toán khác.

 

[ndu96081631]

---
Hết sức trân trọng sự nhiệt tình của chú, chú để anh có thời gian tiêu hóa . Chú có thể giải thích rỏ chổ này nhé

With ActiveSheet
Do
i = i + 1
Loop Until Sheets(ShName & i) Is Nothing
End With
End Sub

Tức là dùng vòng lập Do...Loop để xét từng thằng UngLuong-CnV1, UngLuong-CnV2, UngLuong-CnV3.... xem các sheet này có tồn tại không
- Nếu Sheet UngLuong-CnVn tồn tại thì xét thằng tiếp theo (bằng cách tăng biến i lên 1 đơn vị)
- Nếu sheet UngLuong-CnVn không tồn tại thì ngưng vòng lập (xác định i tại điểm này rồi gán vào sheet vừa tạo)
Mục đích cuối cùng cũng chỉ sợ rằng đặt tên sheet bị trùng với cái có sẳn

 

[tam8678]

Em rút gọn lại code tí, không copy cells mà dùng copy sheet và bỏ luôn Function

---
Việc này lỗi do anh diển đạt không hết ý, vì trong sheet có code nên khi copy sheet thì mang theo cả code trong sheet, anh viết xử dụng trong file đính kèm copy cells là thế. Không biết chú có thể làm như thế nào mà copy sheet và bỏ luôn Function mà không mang theo code trong sheet không?

 

[ndu96081631]

---
Việc này lỗi do anh diển đạt không hết ý, vì trong sheet có code nên khi copy sheet thì mang theo cả code trong sheet, anh viết xử dụng trong file đính kèm copy cells là thế. Không biết chú có thể làm như thế nào mà copy sheet và bỏ luôn Function mà không mang theo code trong sheet không?

Nếu vậy thì lại phải dùng thêm đoạn code để xóa code trong sheet mới copy thôi anh à
Cái này nhớ có lần anh đã hỏi tại đây rồi còn gì:
http://www.giaiphapexcel.com/forum/showthread.php?47158-H%C6%B0%E1%BB%9Bng-d%E1%BA%A9n-v%E1%BB%81-Code-%C4%91%E1%BB%83-xo%C3%A1-Code-trong-sheet-m%E1%BB%9Bi-sau-khi-move-or-copy
Vậy thì... Tùy ý sử dụng
Chẳng hạn thế này:

Sub AAA_UngLuong()
  Dim CurSh As Worksheet
  On Error Resume Next
  Const ShName = "UngLuong-CnV"
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  Sheets(ShName).Copy After:=Sheets(Sheets.Count)
  Set CurSh = ActiveSheet
  With CurSh
    Do
      i = i + 1
    Loop Until Sheets(ShName & i) Is Nothing
    .Name = ShName & i
    .DrawingObjects.Delete
    .Tab.ColorIndex = 8
    With .Range(.[A10], .[A500].End(xlUp)).Resize(, 7)
      .Borders.LineStyle = 0
      .Borders.LineStyle = 1
      .Borders(xlInsideHorizontal).Weight = 1
    End With
    .Range("C1").Value = "Baïn haõy xöû duïng sheet naøy ñeå chænh trang in vaø Löu döõ lieäu - 05.04.2011"
  End With
  With ThisWorkbook.VBProject.VBComponents(CurSh.CodeName).CodeModule
    .DeleteLines 1, .CountOfLines
  End With
  Sheets(ShName).Activate
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
End Sub

 

[ivy le]

Hi các anh,

Hiện em đang gặp rắc rối y như anh Tam nhưng đọc bài này rùi mà chẳng hiểu gì cả. Thật xin lỗi vì khả năng hiểu biết của em về excel hơi bị tệ. Nhưng em mong mấy anh có cách nào chỉ giúp em mà không đụng đến cái vụ code được ko ah? Với lại em làm theo anh ndu hướng dẫn - copy code vào bảng code trong sheet, sau đó đổi tên A thành TV_001 rùi sau đó chẳng biết làm gì nữa. ra bảng excel để tạo thêm sheet mới, nó không tạo được tên sheet TV_002. Em chẳng biết làm sao nữa. Mong các anh trợ giúp em với nhé

cám ơn các anh thật nhiều.

 

[tam8678]

Nhưng em mong mấy anh có cách nào chỉ giúp em mà không đụng đến cái vụ code được ko ah?
cám ơn các anh thật nhiều.

---
Vậy thì bạn xử dụng Move or copy, xong rồi đặt tên sheet .
---

Với lại em làm theo anh ndu hướng dẫn - copy code vào bảng code trong sheet, sau đó đổi tên A thành TV_001 rùi sau đó chẳng biết làm gì nữa

Code nằm trong module, không nằm trong sheet- tên AAA: là tên sub.

 

[ivy le]

Hi anh Tam,

Cái list của em đến 150 sheet và hơn thế nữa. ngồi copy past, rename... thê lương quá nên em mới search cách thực hiện.

Em có thấy cái code khi lick phải chuột trong từng sheet. Không biết như vậy có đúng ko anh.

Hichichic, tới giờ em cũng chưa mò được cách làm vụ này... thảm ghê ẹc ẹc ẹc --- kíu em với.