[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『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
そして、ただの書き間違えだとおもいますが、本当に常に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(月) 14:06
とりあえずの対策は、「MySTR = tmp.Text」のように、見た目の文字列を使うようにしてみてください。(見た目を2018/8/3にすると、同じ理由で無限ループしてしまいますが)
(???) 2018/08/06(月) 14:25
A1セルからA5セルの書式設定を文字列にするのでも。
(ねむねむ) 2018/08/06(月) 14:32
>半角スラッシュは使えないのでエラーになり、無限ループに陥っている
なるほど。複数セルいっぺんにかえたときと、クリアしたときのことは考えていたけど禁則文字までは頭が回ってなかったです。
踏まえて長くなったけど修正版。(なんかすっきりしないですが私の技術はこれが限界・・・)
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.