Tự động đổi tên của sheet (1 người xem)

[tantan]

Mình có sưu tầm được 1 đoạn code để thay đổi tên của worksheet theo ô cho trước.

Private Sub Worksheet_Deactivate()
On Error GoTo ext
Me.Name = [A1]
ext:
End Sub

Tuy nhiên muốn làm cho cả workbook thì mình chưa biết làm thế nào (không phải copy code cho tất cả các sheet, vì như vậy rất mệt)
Thêm vào đó mỗi lần thay đổi dữ liệu trong ô sẽ nhập tên, tên của worksheet không tự thay đổi mà phải kích vào tên sheet rồi quay trở lại mới update tên mới.

Chủ đề này đã có trên GPEX tuy nhiên đã rất lâu rồi nên mình mạo muội tạo chủ đề mới, nếu mod không đồng ý có thể xóa đi.

Rất mong anh em giúp đỡ.

 

[huuthang_bd]

Mình có sưu tầm được 1 đoạn code để thay đổi tên của worksheet theo ô cho trước.

Private Sub Worksheet_Deactivate()
On Error GoTo ext
Me.Name = [A1]
ext:
End Sub

Tuy nhiên muốn làm cho cả workbook thì mình chưa biết làm thế nào (không phải copy code cho tất cả các sheet, vì như vậy rất mệt)
Thêm vào đó mỗi lần thay đổi dữ liệu trong ô sẽ nhập tên, tên của worksheet không tự thay đổi mà phải kích vào tên sheet rồi quay trở lại mới update tên mới.

Chủ đề này đã có trên GPEX tuy nhiên đã rất lâu rồi nên mình mạo muội tạo chủ đề mới, nếu mod không đồng ý có thể xóa đi.

Rất mong anh em giúp đỡ.

Bạn copy Code này vào ThisWorkbook:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Sh.[A1]) = Sh.[A1] Then Sh.Name = Sh.[A1]
End Sub

 

[nghiaphuc]

Mình có sưu tầm được 1 đoạn code để thay đổi tên của worksheet theo ô cho trước.

Private Sub Worksheet_Deactivate()
On Error GoTo ext
Me.Name = [A1]
ext:
End Sub

Tuy nhiên muốn làm cho cả workbook thì mình chưa biết làm thế nào (không phải copy code cho tất cả các sheet, vì như vậy rất mệt)
Thêm vào đó mỗi lần thay đổi dữ liệu trong ô sẽ nhập tên, tên của worksheet không tự thay đổi mà phải kích vào tên sheet rồi quay trở lại mới update tên mới.

Chủ đề này đã có trên GPEX tuy nhiên đã rất lâu rồi nên mình mạo muội tạo chủ đề mới, nếu mod không đồng ý có thể xóa đi.

Rất mong anh em giúp đỡ.

Bạn sử dụng 2 sub sau cho đối tượng ThisWorkbook:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Target.Address <> "$A$1" Or Target.Count > 1 Then Exit Sub
    On Error Resume Next
    Sh.Name = Target
End Sub
Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    On Error Resume Next
    Sh.Name = Sh.[A1]
End Sub

 

[tantan]

Thank 2 bạn nhiệt tình, mình đã chạy thử, kết quả của bạn huuthang_bd rất đúng ý của mình, sau khi gõ tên xong tự động update luôn, còn code của bạn nghiaphuc vẫn phải bấm vào sheetname để update.

 

[nghiaphuc]

Thank 2 bạn nhiệt tình, mình đã chạy thử, kết quả của bạn huuthang_bd rất đúng ý của mình, sau khi gõ tên xong tự động update luôn, còn code của bạn nghiaphuc vẫn phải bấm vào sheetname để update.

Sao vậy nhỉ? Trong 2 sub trên thì Sub Workbook_SheetChange cho phép thay đổi tên sheet ngay khi bạn sửa nội dung ô A1 mà.

 

[tantan]

Mình hiểu tại sao rồi. Công thức của bạn tại A1, nhập xong bao giờ cũng enter kết quả OK nhưng mình lại link giá trị A1 = B1 chẳng hạn nên khi nhập xong B1 nó không chạy ngay.
Cho mình hỏi thêm muốn các code tự động chạy có cần thêm câu lệnh gì? Mình có 1 code để tính tổng theo màu của giá trị nhưng không biết làm thế nào để làm như yêu cầu trên?
Mình mới tìm hiểu VBA nên nhiều cái chưa biết nhưng vì công việc nên hỏi trước. Rất mong các bạn giúp

 

[trungtruc0512]

Bạn copy Code này vào ThisWorkbook:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Intersect(Target, Sh.[A1]) = Sh.[A1] Then Sh.Name = Sh.[A1]
End Sub

Cám ơn bạn nhiều nha. Thật tối ưu.

 

[tueyennhi]

Cho mình hỏi code sau

Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rTarget As Range, aTarget, i As Long, n As Long
  Dim Arr1(), Arr2(), Arr3(), tmp
  On Error Resume Next

  If Dic Is Nothing Then Auto_Open
  If Not Intersect(Range("C6:C10000"), Target) Is Nothing Then
    Set rTarget = Intersect(Range("C6:C10000"), Target)
    If IsArray(rTarget.Value) Then
      aTarget = rTarget.Value
    Else
      ReDim aTarget(1 To 1, 1 To 1)
      aTarget(1, 1) = rTarget.Value
    End If
    ReDim Arr1(1 To UBound(aTarget, 1), 1 To 2)
    ReDim Arr2(1 To UBound(aTarget, 1), 1 To 3)
    ReDim Arr3(1 To UBound(aTarget, 1), 1 To 1)
    For i = 1 To UBound(aTarget, 1)
      If aTarget(i, 1) <> "" Then
        tmp = aTarget(i, 1)
        If Dic.Exists(tmp) Then
          Arr1(i, 1) = aResult(Dic.Item(tmp), 3)

        End If
      End If
 
    Next

    rTarget.Offset(, 4).Resize(, 1).Value = Arr1

  End If
End Sub

Mình đã để vào This book nhưng vấn đề của mình là mình không muốn update một sheet chỉ định ví dụ sheet đó tên là BCC thì mình phải làm thế nào?
Code này của thầy Ndu viết cho nhưng mình không nhớ trước mình hỏi ở đâu nên hỏi luôn vô đây vì thấy nó cũng có chút tương đồng.