Đăt tên sheet dựa vào 1 list dữ liệu cho sẵn

[Hai Lúa Miền Tây]

Các anh chị cho em hỏi là có cách nào tạo tên 1 sheet dựa vào 1 cell trong bảng, điều kiện là cell đó phải là điều kiện để lookup cột kế bên của bảng dữ liệu, từ đó lấy kết quả đó để đặt tên cho sheet.
Em xin cám ơn trước.

 

[ndu96081631]

Các anh chị cho em hỏi là có cách nào tạo tên 1 sheet dựa vào 1 cell trong bảng, điều kiện là cell đó phải là điều kiện để lookup cột kế bên của bảng dữ liệu, từ đó lấy kết quả đó để đặt tên cho sheet.
Em xin cám ơn trước.

Trời... có thật là bạn hỏi câu này không nhỉ? (vì mình không nghĩ là bạn làm không được)

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Target.Address = "$G$2" Then
    With Range("A4").CurrentRegion
      ActiveSheet.Name = .Find(Target)(, 2)
    End With
  End If
End Sub

 

[Hai Lúa Miền Tây]

Lại một lần nữa cám ơn thầy.

Ý của em là mình dùng bảng Data đó ứng dụng cho cả Workbook, xin lỗi vì em không diễn đạt kỹ.

Em xin cám ơn trước.

 

[ndu96081631]

Lại một lần nữa cám ơn thầy.

Ý của em là mình dùng bảng Data đó ứng dụng cho cả Workbook, xin lỗi vì em không diễn đạt kỹ.

Em xin cám ơn trước.

Nghĩa là sao? Tôi chưa hiểu lắm! Bạn giải thích rõ thêm chút đi

 

[MinhNguyệt]

Các anh chị cho em hỏi là có cách nào tạo tên 1 sheet dựa vào 1 cell trong bảng, điều kiện là cell đó phải là điều kiện để lookup cột kế bên của bảng dữ liệu, từ đó lấy kết quả đó để đặt tên cho sheet.
Em xin cám ơn trước.

Không biết ý bạn có phải như thế này không?
1/ Khi gõ tên bất kỳ vào ô G2 thì nó lookup lấy giá trị của ô tại cột B tương ứng trong bảng cho sẵn
2/ Add thêm một sheet nữa, lấy tên sau khi lookup giá trị ở cột B để gán cho sheet này?

Nếu đúng như thế thì
1/ Đặt một name là DaTa chứa bảng dữ liệu trong hai cột A và B
2/ Đặt code sau vào trong module

Sub TaoSheet()
    Dim TenSh As String
    TenSh = Application.WorksheetFunction.VLookup(Sheet1.Range("G2"), Sheet1.Range("DaTa"), 2, 0)
    Sheets.Add.Name = TenSh
End Sub

 

[Hai Lúa Miền Tây]

To MinhNguyet: Rất cám ơn bạn nhưng ý mình không phải như vậy.
To thầy ndu96081631: Ý em là em dùng bảng Data đó cho toàn bộ Book. Ở trên là chỉ sử dụng cho 1 sheet mà thôi. (Em xin lỗi vì không biết cách diễn đạt)
Em xin cám ơn trước.

 

[ptm0412]

Domfootwear xem file này thử. Mỗi sheet có 1 thủ tục này:

Private Sub Worksheet_Change(ByVal Target As Range)
If target.Address = "$G$2" Then
a = Target
RenameSheet a
End If
End Sub

Trong module:

Sub RenameSheet(a)
NewName = Application.VLookup(a, Sheet1.Range("ShNamelist"), 2, 0)
For Each Sht In ThisWorkbook.Sheets
If Sht.Name = NewName Then NewName = NewName & "1"
Next
ActiveSheet.Name = NewName
End Sub

 

[ndu96081631]

To MinhNguyet: Rất cám ơn bạn nhưng ý mình không phải như vậy.
To thầy ndu96081631: Ý em là em dùng bảng Data đó cho toàn bộ Book. Ở trên là chỉ sử dụng cho 1 sheet mà thôi. (Em xin lỗi vì không biết cách diễn đạt)
Em xin cám ơn trước.

Thì cũng thế thôi, lần trước là Worksheet_Change... lần này dùng Workbook_SheetChange

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  On Error Resume Next
  If Target.Address = "$G$2" And Sh.Name <> "data" Then
    With Sheets("data").Range("A4").CurrentRegion
      Sh.Name = .Find(Target, LookAt:=xlWhole).Offset(, 1).Value
    End With
  End If
End Sub

 

[Hai Lúa Miền Tây]

Đúng ý em rồi,
Cả 2 cách đều hay.
Em cám ơn rất nhiều.

 

[TrungChinhs]

Chào các bạn ! Tôi muốn Khi Texbox nào đó được chọn mà có nội dung giống như trong cột D thì đổi tên Sheet theo tên tại cột E Tôi đã tham khảo các bài trên nhưng vẫn không làm được. Nhờ các bạn sửa giúp code trong file đính kèm

 

[ndu96081631]

Chào các bạn ! Tôi muốn Khi Texbox nào đó được chọn mà có nội dung giống như trong cột D thì đổi tên Sheet theo tên tại cột E Tôi đã tham khảo các bài trên nhưng vẫn không làm được. Nhờ các bạn sửa giúp code trong file đính kèm

anh dùng TextBox được vẽ bằng Shape, hơi khó viết code ---> Sao anh không chọn thẳng vào cell tại cột D luôn?

 

[TrungChinhs]

Chả là tôi đang trả lời bài này
http://www.giaiphapexcel.com/forum/showpost.php?p=188481&postcount=3

và muốn cải tiến một chút để code tổng quát hơn không phải viết thêm vòng lặp khi thêm sheet

 

[ndu96081631]

Chả là tôi đang trả lời bài này
http://www.giaiphapexcel.com/forum/showpost.php?p=188481&postcount=3

và muốn cải tiến một chút để code tổng quát hơn không phải viết thêm vòng lặp khi thêm sheet

Em làm được rồi... Anh thử code này xem nha:

Sub TenSheet()
  Dim Shp As Shape
  With ActiveSheet
    For Each Shp In .Shapes
      If Shp.Name = .Shapes(Application.Caller).Name Then
        .Name = Range("D3:D7").Find(Shp.TextFrame.Characters.Text, , , xlWhole)(, 2).Value
      End If
    Next
  End With
End Sub

 

[TrungChinhs]

Bạn giúp tiếp là mỗi texbox chỉ ứng với một sheet thôi có nghĩa là nếu chọn texbox1 thì đổi tên Sheet1; nếu chọn texbox2 thì đổi tên Sheet2...

 

[ndu96081631]

Ah... không...
Không cần vòng lập luôn...
Sửa lại thế này:

Sub TenSheet()
  Dim Shp As Shape
  With ActiveSheet
    Set Shp = .Shapes(Application.Caller)
    .Name = Range("D3:D7").Find(Shp.TextFrame.Characters.Text, , , xlWhole)(, 2).Value
  End With
End Sub

 

[ndu96081631]

Bạn giúp tiếp là mỗi texbox chỉ ứng với một sheet thôi có nghĩa là nếu chọn texbox1 thì đổi tên Sheet1; nếu chọn texbox2 thì đổi tên Sheet2...

Ôi.... Làm rồi lại thấy anh thêm.. câu hỏi

Sub TenSheet()
  Dim Shp As String, i As Long
  On Error Resume Next
  With ActiveSheet
    Shp = .Shapes(Application.Caller).TextFrame.Characters.Text
    i = WorksheetFunction.Match(Shp, Range("D3:D7"), 0)
    Sheets(i).Name = Range("D3:D7").Find(Shp, , , xlWhole)(, 2).Value
  End With
End Sub

 

[TrungChinhs]

Cảm ơn Ndu mình test OK rồi ? lấy luôn cả 2 code để ứng dụng tuỳ từng trường hơp.