[[20180806112156]] 『Excelで出来ませんか?』(名無し) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『Excelで出来ませんか?』(名無し)

★説明用に例数を減らして説明しています。

Excelの中にsheetが6枚あります。

sheet 6のA1〜A5に入力した文字or数字を

sheet 1〜5内の各セルB1 と 各タブ(シート名) に反映されるようにしたい。

例えば、

sheet6のA1に 2018年 と入力したら

sheet 1のB1セルとsheet 1のシート名が 2018年 に代わるようにしたい。

sheet6のA1に 管理簿 と入力したら

sheet 2のB1セルとsheet 2のシート名が 管理簿 に代わるようにしたい

修正するタブとセルが多く・・一つずつやるには手間がかかってしまいどうにかできませんでしょうか??

よろしくお願い致します。

< 使用 Excel:Excel2010、使用 OS:unknown >


参考になれば幸いです、、

Private Sub Worksheet_Change(ByVal Target As Range)

    If ThisWorkbook.Sheets("Sheet6").Range("A1:A5").Find(Target.Value) Is Nothing Then
        If Target.Row <= 5 And Target.Column = 1 And Target.Value <> "" Then
            With ThisWorkbook.Sheets(Target.Row)
                .Range("B1") = Target.Value
                .Name = Target.Value
            End With
        End If
    End If
End Sub

(TAKA) 2018/08/06(月) 11:58


とりあえず。
・シート名(シート見出し)を能動的に変更したいならVBAを使うしか無いと思います。
・シート名をセルに表示させるだけなら、数式でもVBAでもできます。
数式でやる場合→https://kokodane.com/kan54.htm

そして、ただの書き間違えだとおもいますが、本当に常にsheet6のA1に入力したいというのであれば、条件分岐を加える必要があるので難易度が上がりますね。
なので、本当は↓じゃないですか?

たとえば、左から6番目のシートのA列のうち1行目から5行目に入力するとして
1行目に「2018年」と入力したら左から1番目のシート名を「2018年」に変更して、そのシートのB1セルに「2018年」、
2行目に「2018年」と入力したら左から2番目のシート名を「管理簿」に変更して、そのシートのB1セルに「管理簿」
というように、行と左から〇番目のシートというのが関連しているときに、入力したものが、そのままシート名にも反映されるようにしたい。

そうであれば、
れば、TAKAさんのコードをいじらせて頂いて、
以下のコードを、シートモジュール「Sheet6(Sheet6)」というところに貼り付ければ、希望の動作になると思います。

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim MySTR As String
        Dim MyRNG As Range: Set MyRNG = Intersect(Target, Range("A1:A5"))
        Dim tmp As Variant
        If MyRNG Is Nothing Then Exit Sub

        On Error GoTo エラートラップ

        For Each tmp In MyRNG
            If tmp.Value <> "" Then
                MySTR = tmp.Value
                With ThisWorkbook.Sheets(tmp.Row)
                    .Range("B1") = MySTR
                    .Name = MySTR
                End With
            End If
        Next tmp
    Exit Sub

    エラートラップ:
        MySTR = MySTR & "(2)"
        Resume    

    End Sub

興味があれば、なんでそうなるのか「ブレークポイント」を設定したりして、途中で止まるようにした上で「ステップ実行」して研究してみて下さい。

(もこな2) 2018/08/06(月) 13:03


ありがとうございます!!
本当に助かりました!
(名無し) 2018/08/06(月) 13:33

もこな2様
ありがとうございます。
こちら、例えば8月6日などの入力はできないのでしょうか?

応答なし になって固まってしまいます。
こちらのパソコンの能力の問題ですか??

(名無し) 2018/08/06(月) 14:06


おそらく、セルの見た目は8月6日ですが、価は2018/8/3になっているのかと思います。 すると、シート名に半角スラッシュは使えないのでエラーになり、無限ループに陥っているのでしょう。

とりあえずの対策は、「MySTR = tmp.Text」のように、見た目の文字列を使うようにしてみてください。(見た目を2018/8/3にすると、同じ理由で無限ループしてしまいますが)
(???) 2018/08/06(月) 14:25


 A1セルからA5セルの書式設定を文字列にするのでも。

(ねむねむ) 2018/08/06(月) 14:32


ありがとうございます!!
できました!!
(名無し) 2018/08/06(月) 15:20

解決したっぽいですが一応。

>半角スラッシュは使えないのでエラーになり、無限ループに陥っている
なるほど。複数セルいっぺんにかえたときと、クリアしたときのことは考えていたけど禁則文字までは頭が回ってなかったです。

踏まえて長くなったけど修正版。(なんかすっきりしないですが私の技術はこれが限界・・・)

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim MySTR As String
        Dim MyRNG As Range: Set MyRNG = Intersect(Target, Range("A1:A5"))
        Dim tmp As Variant, buf As Variant

        If MyRNG Is Nothing Then Exit Sub
        On Error GoTo エラートラップ        

        For Each tmp In MyRNG
            If tmp.Value <> "" Then
                MySTR = tmp.Value
                With ThisWorkbook.Sheets(tmp.Row)
                    .Name = MySTR
                    .Range("B1") = MySTR
                End With
            End If
        Next tmp
    Exit Sub

    エラートラップ:
        '禁則文字等チェック
        If Len(MySTR) > 31 Then GoTo エラー処理
        For Each buf In Array(":", "\", "/", "~?", "~*")
            If MySTR Like "*" & buf & "*" Then GoTo エラー処理
        Next
        If InStr(MySTR, "[") Then GoTo エラー処理
        If InStr(MySTR, "]") Then GoTo エラー処理

        'シート名重複処理
        MySTR = MySTR & "(2)"
        Resume

    エラー処理:
        Dim msg As String
        msg = tmp.Row & "番目のシート名は以下のように変更できません。" & vbCrLf & _
              MySTR & vbCrLf & vbCrLf & _
              "次の点を確認して修正してください。" & vbCrLf & _
              "・入力文字が31文字以内であること" & vbCrLf & _
              "・次の使用できない文字が含まれていないこと" & vbCrLf & _
              " コロン(:)、円記号(\)、スラッシュ(/)、疑問符(?)、" & vbCrLf & _
              " アスタリスク(*)、左角カッコ([)、右角カッコ(])"
        MsgBox msg, vbExclamation, "エラー"

    End Sub
(もこな2) 2018/08/07(火) 01:02

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.