1

これが単純な場合は申し訳ありませんが、私はVBAが初めてです。最初のシートの特定のセル (A1、A2、A3、A4 など) が変更されると、他の 4 つのシートの名前が一致するように変更されるように、Excel シートを設定しようとしています。そのシートの特定のセルを変更すると機能する次の式を見つけました。

`

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 を以前に指定したメイン シートの 4 つのセルの 1 つに依存するように変更すると、A1 が保存されているシートの変更のみを検索するため、機能しません。

VBA を使用して 1 つのシートのセルを確認し、別のシートのシート名を一致するように変更する方法はありますか?

ありがとう

4

1 に答える 1

2

コメントで述べたように、シートの名前を変更するのはそれほど簡単ではありません。いろいろチェックしないといけない。

私の仮定

  1. ワークブックには 5 つのシートがあります。Sheet1、Sheet2、Sheet3、Sheet4およびSheet5
  2. でセルを変更すると、変更Sheet5するセルによってSheets1-4's名前が変わる
  3. A1変更すると、名前が変更されると想定していSheet1ます。A2変更時、名前が変更されたときSheet2など...

論理

  1. Worksheet_Changeイベントを使用してセルA1、A2、A3またはへの変更をトラップするA4
  2. Sheet 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

スクリーンショット

ここに画像の説明を入力

于 2013-09-18T09:44:22.600 に答える