[[20170218000635]] 『自動化したシート名の表示形式を変更する方法』(たろう) ページの最後に飛ぶ

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

 

『自動化したシート名の表示形式を変更する方法』(たろう)

教えていただきたいことがあります。
以下のようなマクロで、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

修正してみましたが、やはりシート名は日付「平成29年02月18日」のままとなってしまいます。
(たろう) 2017/02/18(土) 00:32

 これなら、どうですか?
 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


ご対応ありがとうございます。
きちんと稼働するようになりました。
そこでひとつ質問です。
一旦日付を入力すると、「0218」という形でシート名が自動化されますが、
その日付を削除してそのセルをクリックすると、エラー表示1004となります。
その場合の対応として、削除してクリックすると元々のシート名に戻るとか、
エラー表示させないコードにさせたいと思うのですが、いかがでしょうか?
(たろう) 2017/02/18(土) 06:53

 >その日付を削除してそのセルをクリックすると、エラー表示1004となります。 

 原因は ( β) 2017/02/18(土) 06:51 でコメントした通りですので、コードの流れとしては
 マリオさん提示のコードを(もったいないですが)捨てて、元のコードにして、Me.Name の設定コードのみの変更にしておいてくださいね。

 そうすれば、エラー時は元のシート名のままになります。もとの たろう さんのコードが、そうなっているんです。

 ★マリオさん提示のコードは シート名設定時のエラーを シート名重複のケースだけとして
  それを回避しているわけですから、セルクリアのみならず、手が触れて、シート名としては不適切な文字が入った途端に
  エラーになるわけです。

( β) 2017/02/18(土) 07:14


つまりは、
If Target.Cells(1, 1).Address = "$C$20" Then 部分が

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.