[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『自動化したシート名の表示形式を変更する方法』(たろう)
教えていただきたいことがあります。
以下のようなマクロで、C20には「平成29年02月18日」という日付が入力されていて、その日付が自動でシート名になるというものです。
このシート名を月日表示にさせて、「0218」という形式のシート名にさせたいのですが、私は、
= Text("$C$20","mmdd") Then
としたのですが、結果がでません。
誤りをご指導ください。
よろしくお願いします。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ERR:
If Target.Cells(1, 1).Address = "$C$20" Then
Me.Name = Target.Cells(1, 1).Text
End If
Target.Cells(1, 1).Select
Exit Sub
ERR:
MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR"
Resume Next
End Sub
< 使用 Excel:Excel2013、使用 OS:Windows8 >
>Text("$C$20","mmdd") Then
Format("$C$20","mmdd") Then
かと思います。
(マリオ) 2017/02/18(土) 00:26
これなら、どうですか?
Private Sub Worksheet_Change(ByVal target As Range)
If target.Count > 1 Then Exit Sub
If target.Address <> "$C$20" Then Exit Sub
Dim sh As Worksheet, flag As Boolean, x As String
x = Format(target, "mmdd")
flag = True
For Each sh In ThisWorkbook.Sheets
If sh.Name = x Then flag = False
Next sh
If flag = True Then
Me.Name = x
Else
MsgBox "他のシートで「" & x & " 」は使用されています"
End If
End Sub (マリオ) 2017/02/18(土) 06:24
すでに解決にたどり着く回答がでましたので蛇足。
まず、指摘があったように シート関数 Text にあたる VBA関数は Format です。
次に、VBAで セル領域を参照する場合、"C20" といった セルアドレス文字列ではなく
Range("C20") といった 領域をあらわすオブジェクトを使います。
今回の場合、変更されたセルが Target という 領域(Range)オブジェクトで渡されていますので その変数を使うことができます。
つまり、回答があった Format(Target,"mmdd") ですね。
(最初に回答された Format("$C$20","mmdd") は 領域が文字列ですからNGだったわけです)
なお、Format で充分なんですが、VBAでも以下のように記述すれば、多くのシート関数が利用できます。 でも、この場合も領域は Rangeオブジェクトで与えます。
WorksheetFunction.Text(Target, "mmdd")
なお、マリオさんの回答コードの流れですけど、シート名が、不正なものであれば実行時エラーになりますので 現在、たろう さんが使っておられるエラートラップを仕掛けたコードのまま つまり Me.Name = Target.Cells(1, 1).Text を直すだけに しておいてください。 (細かなところで記述方法全体の改善もできますが、それは別のテーマなので)
( β) 2017/02/18(土) 06:51
>その日付を削除してそのセルをクリックすると、エラー表示1004となります。
原因は ( β) 2017/02/18(土) 06:51 でコメントした通りですので、コードの流れとしては マリオさん提示のコードを(もったいないですが)捨てて、元のコードにして、Me.Name の設定コードのみの変更にしておいてくださいね。
そうすれば、エラー時は元のシート名のままになります。もとの たろう さんのコードが、そうなっているんです。
★マリオさん提示のコードは シート名設定時のエラーを シート名重複のケースだけとして それを回避しているわけですから、セルクリアのみならず、手が触れて、シート名としては不適切な文字が入った途端に エラーになるわけです。
( β) 2017/02/18(土) 07:14
If Target.Cells(1, 1).Address = Format(Target,"mmdd") Then
に変更でよろしいですか。
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ERR:
If Target.Cells(1, 1).Address = "$C$20" Then
Me.Name = Target.Cells(1, 1).Text
End If
Target.Cells(1, 1).Select
Exit Sub
ERR:
MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR"
Resume Next
End Sub
(たろう) 2017/02/18(土) 07:31
>たろうさん >その日付を削除してそのセルをクリックすると、エラー表示1004となります。
もし、私のコードを使用するなら、次のようにしてください。 ★を付加している行(3行分)が追加行です。
Private Sub Worksheet_Change(ByVal target As Range)
If target.Count > 1 Then Exit Sub
If target.Address <> "$C$20" Then Exit Sub
If IsDate(target) = False Then Exit Sub '★
Dim sh As Worksheet, flag As Boolean, x As String
x = Format(target, "mmdd")
flag = True
For Each sh In ThisWorkbook.Sheets
If sh.Name <> ActiveSheet.Name Then '★
If sh.Name = x Then flag = False
End If '★
Next sh
If flag = True Then
Me.Name = x
Else
MsgBox "他のシートで「" & x & " 」は使用されています"
End If
End Sub
(マリオ) 2017/02/18(土) 07:42
To マリオさん
最初に IsDate で不正文字の入力を回避させているところがミソでしょうけど、本件、本質は 重複シート名だけの話ではなく、シート名として使用できない何種類かの文字列入力を防ぐということですから 再掲されたようなループチェックも、悪くはないのですが、ストレートに、元の たろうさんのコードのような エラートラップがベストだと思いますよ。
To たろうさん
>つまりは、 >If Target.Cells(1, 1).Address = "$C$20" Then 部分が >If Target.Cells(1, 1).Address = Format(Target,"mmdd") Then >に変更でよろしいですか
違います。
元のコードの
Me.Name = Target.Cells(1, 1).Text
これを
Me.Nmae = Format(Target,"mmdd")
あるいは
Me.Name = WorksheetFunction.Text(Target, "mmdd")
に直すだけでいいですよ ということを申し上げています。
( β) 2017/02/18(土) 08:28
もし、マリオさんのコードのように 操作者が入力したものが 適切ではなかった場合に その理由をメッセージで表示してやるということであれば、以下のようなコードが考えられます。 ただ、ここまでする必要はないかと。
Private Sub Worksheet_Change(ByVal target As Range)
Dim shn As Variant
Dim sh As Worksheet
Dim nName As String
If Intersect(target, Range("C20")) Is Nothing Then Exit Sub
shn = Range("C20").Value
If IsEmpty(shn) Then Exit Sub
If Not IsDate(shn) Then
MsgBox "日付型の値で入力してください"
Exit Sub
End If
nName = Format(shn, "mmdd")
If Me.Name = nName Then Exit Sub
For Each sh In ThisWorkbook.Sheets
If sh.Name = nName Then
MsgBox "他のシートで「" & nName & " 」は使用されています"
Exit Sub
End If
Next
Me.Name = nName
End Sub
( β) 2017/02/18(土) 08:56
To βさん 質問者が知りたい情報を先に提供する。それができてないんですよね。 すいません。
>たろう さん
たろうさんのコードを元に、「a」とか「1」と入力されてしまったとき 対策のコードを書いてみました。★箇所が追加箇所です。
元のたろうさんのコードですと、次のようになると思います。この対策をします。 ・C20に「a」を入力するとシート名が、「a」になってしまう。 ・C20に「1」を入力する「1900/1/1」扱いにされてしまい、 「明治33年1月1日」と表示され、シート名は「0101」ではなく、 なぜか「1231」と表示される。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error GoTo ERR:
If Target.Cells(1, 1).Address = "$C$20" Then
Dim buf '★
If IsDate(Target) = False Then '★
Application.Undo '★
buf = 1 / 0 '★
Else '★
If Year(Target) < 2017 Then '★
Application.Undo '★
buf = 1 / 0 '★
End If '★
End If '★
Me.Name = Format(Target, "mmdd")
End If
Target.Cells(1, 1).Select
Exit Sub
ERR:
MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR"
Resume Next
End Sub
(マリオ) 2017/02/18(土) 09:35
To マリオさん
Application.Undo により Changeイベントが連鎖します。 ですから Application.EnableEvents の手当てが必要かと。
( β) 2017/02/18(土) 10:00
>β さん >Application.Undo により Changeイベントが連鎖します。 そういう発想が皆無でした。教えて頂き、ありがとうございます m(_ _)m
Application.EnableEvents の手当てって、どう記述したらいいですかね。 教えてください。
(マリオ) 2017/02/18(土) 10:23
このコードでは 最後の Exit Sub 以外は 途中での Exit Sub がないですから
If Target.Cells(1, 1).Address = "$C$20" Then
この下に
Application.EnableEvents = False
で、Exit Sub の 上に
Application.EnableEvents = True
を記述すればよろしいかと。
( β) 2017/02/18(土) 10:30
To βさん
buf = 1 / 0 の代わりに、GoTo ERR: にしたら、うまく動作しませんね。何故でしょうか?ん〜。
>Exit Sub の 上に >Application.EnableEvents = True シート上で、何らかの変化を起こしているコードの後に記述するってことですかね?(Msgboxは、シート処理でない)
何度も書いてますが、もう一度書き込みます。
Private Sub Worksheet_Change(ByVal target As Excel.Range)
On Error GoTo ERR:
If target.Cells(1, 1).Address = "$C$20" Then
Application.EnableEvents = False '★
Dim buf '★
If IsDate(target) = False Then '★
Application.Undo '★
buf = 1 / 0 '★
Else '★
If Year(target) < 2017 Then '★
Application.Undo '★
buf = 1 / 0 '★
End If '★
End If '★
Me.Name = Format(target, "mmdd")
End If
target.Cells(1, 1).Select
Application.EnableEvents = True '★
Exit Sub
ERR:
MsgBox "その名前には変更出来ません。", vbCritical + vbOKOnly, "ERROR"
Resume Next
End Sub
(マリオ) 2017/02/18(土) 11:03
うまく動作しません というのは、具体的には、どうなるということでしょうか?
ところで、ちょっと感想。(マリオさんには辛口のコメントになるかもしれませんが)
まず、質問者さんの特定の質問テーマのトピが、なんだかわかりにくくなっている。 このトピのテーマって何だったんだろうと、質問者さんもROMメンバーもわかりにくくなっています。
この種の質問でコードが質問者さんからアップされる。 最終的に、それを、もっと ユーザーインターフェースを考えて操作者に親切なコードにしたものを 参考コードとしてアップしてあげるということは、悪いことではありません。
ただ、順序としては、まず、質問者さんの質問に対する、直接的なアドバイスなり間違いの訂正なりが最初でしょうね。
今回でいえば、コード全体の構成としては間違っているわけではなく、間違いは、あくまで単純なコード記述間違いだったわけです。
つまり、
If Target.Cells(1, 1).Address = "$C$20" Then
Me.Name = Target.Cells(1, 1).Text
ここを
If Target.Cells(1, 1).Address = Text("$C$20","mmdd") Then
Me.Name = Target.Cells(1, 1).Text
にしたのか
If Target.Cells(1, 1).Address = "$C$20" Then
Me.Name = Text("$C$20","mmdd")
にしたのかわかりませんけど、そこを確認した上で、あくまで VBAでは Text関数は、このままでは使えないという方向で 間違いを教えてあげることが必要だったわけです。
それに対し、マリオさんの回答の最初が、Format("$C$20","mmdd")、これは、あきらかに間違いですけど
こうだった。
で、質問者さんから だめだったとレスがあった。
ここで、あぁ、間違えました というコメントがあればわかりやすかったんですが、それがないまま、 全く別の処理コード案が提示された。
質問者さんから見ると、Format("$C$20","mmdd") という記述は『正しい』けれど、今回のテーマでは
(理由はわからないけど)、マリオさんが提示した全く別の処理構成が必要なんだと
そう、受け取ってしまう恐れがあります。
ということは、次回、別のテーマで日付編集を行うときには、マリオさんの回答のFormat("$C$20","mmdd")を
使ってしまうかもしれない。
そういうことを考えながら回答をしていきたいと、そう思いますね。
(β) 2017/02/18(土) 14:05
To β さん まったく、その通りなので、何も言えません。ごめんなさい。 (マリオ) 2017/02/18(土) 14:22
To β さん、たろう さん 質問者のたろうさん、βさん、を困惑、不快にさせてしまったかもしれません。申し訳ございませんでした。
To β さん >うまく動作しません というのは、具体的には、どうなるということでしょうか?
太郎さんの質問内容から、逸脱してますので、別トピを立てます。 よろしくお願いします。 『セルの値が変化したらシート名変更■Worksheet_Change』(マリオ) [[20170218152800]]
(マリオ) 2017/02/18(土) 15:33
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.