2013-09-18 3 views
1

Извините, если это просто, но я новичок в VBA. Я пытаюсь настроить лист Excel так, чтобы при изменении определенных ячеек на первом листе (например, A1, A2, A3, A4) имена четырех других листов изменились в соответствии с ними. Я нашел следующую формулу, которая работает, если я изменяю конкретную ячейку на этом листе;Динамические имена листов на основе зависимых ячеек

`

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 
     Set Target = Range("A1") 
     If Target = "" Then Exit Sub 
     On Error GoTo Badname 
     ActiveSheet.Name = Left(Target, 31) 
     Exit Sub 
    Badname: 
     MsgBox "Please revise the entry in A1." & Chr(13) _ 
     & "It appears to contain one or more " & Chr(13) _ 
     & "illegal characters." & Chr(13) 
     Range("A1").Activate 
    End Sub 

` К сожалению, это не будет работать, если я изменю A1 быть зависимым от одной из четырех ячеек на главном листе, указанных выше, так как он смотрит только на изменения в балансе оно сохраняется in.

Есть ли способ использовать VBA, чтобы посмотреть на ячейку на одном листе, а затем изменить название листа другого листа для соответствия?

Благодаря

+2

Это не так просто, как это. Вы должны проверить много вещей, например .. Если новое имя является допустимым именем .. Если у вас нет листа с этим именем и т. Д.Позвольте мне посмотреть, могу ли я придумать образец –

ответ

2

Как я уже говорил в комментариях, это не так просто переименовать лист. Вы должны проверить так много вещей.

Мои Предположения

  1. У вас есть 5 листов в книге; Sheet1, Sheet2, Sheet3, Sheet4 и Sheet5
  2. При изменении клеток в Sheet5, в зависимости от клетки, которая изменяется, Sheets1-4's имена изменены
  3. Я предполагаю, что когда A1 изменения, Sheet1 переименован. Когда A2 изменения, Sheet2 переименовывается и так далее ...

Logic

  1. Используйте Worksheet_Change событие изменения ловушки для клеток A1, A2, A3 или A4
  2. Использование листов Codename для измените имя
  3. Проверьте правильность названия листа. Имя листа не может содержать любого из этих символов \/* ? [ ]
  4. Проверьте, если у вас уже есть лист с именем, которое вы хотите использовать для переименования
  5. Если все работяга доры затем идти вперед и заменить

кода

См. Этот пример. Этот код находится в области кода Sheet5.

Dim sMsg As String 

Private Sub Worksheet_Change(ByVal Target As Range) 
    Dim wsName As String 

    On Error GoTo Whoa 

    sMsg = "Success" 

    Application.EnableEvents = False 

    If Not Target.Cells.CountLarge > 1 Then 
     If Not Intersect(Target, Range("A1")) Is Nothing Then 
      wsName = Left(Target, 31) 

      RenameSheet [Sheet1], wsName 
     ElseIf Not Intersect(Target, Range("A2")) Is Nothing Then 
      wsName = Left(Target, 31) 

      RenameSheet [Sheet2], wsName 
     ElseIf Not Intersect(Target, Range("A3")) Is Nothing Then 
      wsName = Left(Target, 31) 

      RenameSheet [Sheet3], wsName 
     ElseIf Not Intersect(Target, Range("A4")) Is Nothing Then 
      wsName = Left(Target, 31) 

      RenameSheet [Sheet4], wsName 
     End If 
    End If 

    MsgBox sMsg 
Letscontinue: 
    Application.EnableEvents = True 
    Exit Sub 
Whoa: 
    MsgBox Err.Description 
    Resume Letscontinue 
End Sub 

'~~> Procedure actually renames the sheet 
Sub RenameSheet(ws As Worksheet, sName As String) 
    If IsNameValid(sName) Then 
     If sheetExists(sName) = False Then 
      ws.Name = sName 
     Else 
      sMsg = "Sheet Name already exists. Please check the data" 
     End If 
    Else 
     sMsg = "Invalid sheet name" 
    End If 
End Sub 

'~~> Check if sheet name is valid 
Function IsNameValid(sWsn As String) As Boolean 
    IsNameValid = True 

    '~~> A sheet name cannot contain any of these Characters \/* ? [ ] 
    For i = 1 To Len(sWsn) 
     Select Case Mid(sWsn, i, 1) 
     Case "\", "/", "*", "?", "[", "]" 
      IsNameValid = False 
      Exit For 
     End Select 
    Next 
End Function 

'~~> Check if the sheet exists 
Function sheetExists(sWsn As String) As Boolean 
    Dim ws As Worksheet 

    On Error Resume Next 
    Set ws = ThisWorkbook.Sheets(sWsn) 
    On Error GoTo 0 

    If Not ws Is Nothing Then sheetExists = True 
End Function 

Скриншот

enter image description here

+1

+1 отличный ответ с хорошим кодом –

+0

@mehow: Спасибо, что нашли время, чтобы оценить его :) –

+0

Это замечательно, спасибо за вашу помощь. Я чувствую себя немного лучше, чем это было достаточно сложно, что я бы никогда не справился с этим сам, но также немного хуже, чем я так мало знаю, что даже не понял, насколько это было сложно. – user2790744

Смежные вопросы