[[20130215155328]]　『セルの配置を特定文字列で変える』（みー）　ページの最後に飛ぶ

『セルの配置を特定文字列で変える』（みー）

 Excel2010を使っています。教えてください。

 ワークシートのM列に「定価」という項目があり、表示形式を「通貨・桁区切り有」に設定しています。

 このM列に、金額（数値）が入った時は右揃え、"-(ハイフン)"が入った時は中央配置にしたいのですが
 条件付き書式にも配置の設定はないみたいで…
 （「定価」という見出しセルは中央配置です）

 現在デフォルトでは右揃えにしていますが、"-"が入った時に自動的に中央揃えにする方法はありますでしょうか？

 シートのレイアウトが今後色々変わる可能性があるので、ワークシートの中にマクロを入れて…
 という方法はあまり取りたくないのですが…

 よろしくお願いします。

Sub mee_sama()

    Dim Row As Long
    Dim i As Long
    Const Column As String = "M"

    For i = 1 To Cells(Rows.Count, Column).End(xlUp).Row
        If InStr(1, Cells(i, Column).Value, "-", vbBinaryCompare) Then
            Cells(i, Column).HorizontalAlignment = xlHAlignCenter
        End If
    Next i

End Sub

こんなんでどうでしょ？　（ハモ）

 いまいちかもしれないが。

 条件付き書式で
 「指定の値を含むセルだけを書式設定」
 「セルの値」「次の値に等しい」「="-"」
 で、書式の「表示形式」で「   @」と設定。
 このときセルの幅に合わせ@の前のスペースの数を調整。
 (ねむねむ)

 ねむねむ様

 それでやってみましたが位置が変わりません…

 ハモ様

 それをワークシートモジュールに入れて実行したら中央配置できましたが、新規データを登録した際、その都度
 実行しないと位置が変わりません…
 自動でできるようにしたいのですが、モジュールの置き場所が違うのでしょうか？

 （みー）

みー様

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim i As Long
    Const Column As String = "M"

    For i = 1 To Cells(Rows.Count, Column).End(xlUp).Row
        If InStr(1, Cells(i, Column).Value, "-", vbBinaryCompare) Then
            Cells(i, Column).HorizontalAlignment = xlHAlignCenter
        End If
    Next i
End Sub

該当するシートモジュールに上のコードを貼ってみてください（ハモ）

ちょっと修正<(_ _)>
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim i As Long
    Const Column As String = "M"
    On Error Resume Next
    For i = 1 To Cells(Rows.Count, Column).End(xlUp).Row
        If InStr(1, Cells(i, Column).Value, "-", vbBinaryCompare) Then
            Cells(i, Column).HorizontalAlignment = xlHAlignCenter
        End If
    Next i
End Sub
こちらのほうにしてください（ハモ）

 ハモ様
 ありがとうございます。

 実は同じ処理をしたい列が4列あるので、シートモジュールに　Const Column As String = "M"　の列の
 部分を変更したものを4列分用意して、

 Private Sub Worksheet_SelectionChange(ByVal Target As Range) 
    Call M列配置
    Call N列配置
    Call O列配置
    Call P列配置
 End Sub

 のようにしてみました。

 それでうまくいったのはいいですが、データ量が多いせいか、セルの値を変更するたびにしばらく固まってしまいます。
 ちょっと処理が重くなったようです…
 でもやはりマクロでやるしかないんですよね…

 （みー）

 "-" 一文字だけ入力された時だけ中央、他は右寄せだよね？

 シートモジュール

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    If Intersect(Target, Columns("m:p")) Is Nothing Then Exit Sub
    For Each r In Intersect(Target, Columns("m:p"))
        r.HorizontalAlignment = IIf(r.Value = "-", xlCenter, xlRight)
    Next
End Sub
(seiya)

 seiya様ありがとうございます。

 ちょうど今、「-100」のように「マイナス」が入った場合に中央に配置されてしまう、という現象を発見したところでした。

 教えていただいた内容でそれは回避できました。

 ありがとうございます。

 （みー）

皆様すみませんでした<(_ _)>
ハモは条件をよく理解していませんでした。

 理解の仕方が違うのはよくることなので、あまり気にしませんが

 > Const Column As String = "M"

 Column はVBAの予約語なので、変数名に使用するのは避けた方がいいと思いますよ？

 (seiya)

seiya様　
予約語だったんですね。ご指摘ありがとうございます。

みー様
改良版です。
Private Sub Worksheet_Change(ByVal Target As Range)

    On Error Resume Next
    With Target
        If .Column = "M" Or _
           .Column = "N" Or _
           .Column = "O" Or _
           .Column = "P" Then
            If .Value = "-" Then
                .HorizontalAlignment = xlHAlignCenter
            End If
        End If
    End With
End Sub
（ハモ）

 重箱の隅をつつくようでいやだけど...

 例えば K6:P17を選択しておいて "-" を入力
 Ctrl + Enter するとどうなる？

 その後、そのまま適当な数値を入力して同じことをすると？

 (seiya)

 ハモ様、seiya様、ありがとうございます。

 今重大な欠点（？）が見つかりました！

 例えば、M～P列の中に何か値を間違って上書き入力し、Ctrl+Zでアンドゥしようとしたら、マクロが実行されたため
 アンドゥができません;;

 これではもし、大事なところを間違えて入力してしまったら、その度に「保存せずに終了」をしない限り元に戻せません…

 （今実際にやらかしてしまいました…）

 元々の条件が無理だったんでしょうか…

 （みー）

seiya 様
ご指摘ありがとうございます。
右揃えになっちゃいますね・・
勉強になりました<(_ _)>

みー様
あまりお役に立てなくてすみませんでした。

（ハモ）

みー様
ハモが思うにリアルタイムの中揃えは断念して（ Undo が使えないから）
上書き保存を押したときにマクロが発動するようにすれば現実的かと思います。

モジュールは ThisWorkbook でイベントは Workbook_BeforeSave 辺りだと思います。
こうすれば作業中 Undo は使えるし、重くなることもないかと思われます。

どうでしょ？（ハモ）

[[20061114093140]] でみやほりんさんが書いてる、書式設定の方法が参考になりませんか（マナ）

 M:P列のセルをダブルクリックでUndo
 条件
 1) M:P の変更は単一セルのみ
 2) 一回前のUndoのみ可能

 Option Explicit

 Private oldVal(1)

 Private Sub Worksheet_Activate()
    oldVal(0) = ActiveCell.Address
    oldVal(1) = ActiveCell.Value
End Sub

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, temp
    If Intersect(Target, Columns("m:p")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Target.Count > 1 Then
        MsgBox "M:P列は単一セルのみ変更可能"
        Application.Undo
    Else
        oldVal(0) = Target.Address
        temp = Target.Value
        Application.Undo
        oldVal(1) = Target.Value
        Target.Value = temp
        Target.HorizontalAlignment = IIf(Target.Value = "-", xlCenter, xlRight)
    End If
    Application.EnableEvents = True
End Sub

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim r As Range, e, temp
    Application.EnableEvents = False
    If Not Intersect(Target(1), Columns("m:p")) Is Nothing Then
        Cancel = True
        temp = Range(oldVal(0)).Value
        Range(oldVal(0)).Value = oldVal(1)
        oldVal(1) = temp
        Target.HorizontalAlignment = IIf(Target.Value = "-", xlCenter, xlRight)
    End If
    Application.EnableEvents = True
End Sub
(seiya)
追記：
書式で設定できればその方がいいけど、コピペで変更することがあるなら値貼り付けに
限定しないと書式が崩れそう...

 皆様色々とあありがとうございます。

 マナ様

 その内容の通りに、新規の列に書式を設定して「*」を入力すると確かに「*」が中央揃えに、数値が右揃えになりました。
 しかし私の理解の仕方が悪いようで、「*」を「-」に置き換え、さらに小数点を表示しないように「.00」の部分を
 削除したらどうしてもうまくいきません…（全部のセルが「-」になったりする）

 ユーザー定義の設定方法が解説してあるサイトを見たのですがどうしてもできません…

 seiya様

 書いていただいたコードをシートモジュールに張り付けたのですが「-」が中央揃えになりません…

 （セルは単一セルに入力しています）

 何度Undoしてもメッセージボックスも表示されないですし…

 ハモ様

 そうですね…
 保存する時だけ実行するようにした方が現実的かもしれないですね…

 皆様色々とすみません…

 （みー）

私もよくわかりませんが、こんな感じでは？（マナ）

 　
配置-横位置-中央揃えで、* \ #,##0;* \ -#,##0;* \ #,##0

参考まで（マナ）

 　
http://www.relief.jp/itnote/archives/003352.php

 ＞「*」を「-」に置き換え、
「*」がカナメなのでこれを消しちゃいけません。
書式文字列の「*」は「*に続く文字列をセルが埋まるだけ繰り返す」という
意味があります。[[20061114093140]] の記事では「*」の次に半角スペースがありますから、
数値表示で余る部分が半角スペースで埋められて、右寄せっぽく見えるようになる理屈です。
　
ただし、等幅フォント（ＭＳゴシック、ＭＳ明朝など）を使用しないと、
表示する数値の桁によってはずれて見えることがあるかもしれません。
　
 * \ #,##0;* \ -#,##0;* \ 0;@
　　　　　　　　　　　↑
　　　　　　　　　　表示形式の第3セクションはこの場合０の時だけ考えればいい。
（みやほりん）

 > 「-」が中央揃えになりません…
 ダブルクリックした時ですか？

 Target.HorizontalAlignment = IIf(Target.Value = "-", xlCenter, xlRight)

を

 Range(oldVal(0)).HorizontalAlignment = IIf(Range(oldVal(0)).Value = "-", xlCenter, xlRight)

 に変更してください。
 (seiya)

 マナ様、みやほりん様、ありがとうございます

 その書式設定を、新しい列に設定してそこに新規入力するとうまくいくのですが、既に値が入っている（現在の）
 列に設定すると、設定が有効にならないんです…

 seiya様ありがとうございます。

 変更したらうまくいきました。
 ただ、「単一セルのみ変更可能」というのが運用上、ちょっとやりにくいかな、と…（贅沢言ってすみません…）
 「M～P列の中でマウスで範囲指定して値をクリア」ができないのでちょっと不便で…

 自分でも方法をもう一度考えてみます

 （みー）

 細かく検証してないのでBugがあるかどうか不明。

 Option Explicit

 Private oldVal()

 Private Sub Worksheet_Activate()
    Dim r As Range, c As Range, n As Long
    If TypeOf Selection Is Range Then
        For Each r In Selection.Areas
            For Each c In r
                n = n + 1
                ReDim Preserve oldVal(1 To 2, 1 To n)
                oldVal(1, n) = c.Address: oldVal(2, n) = c.Value
            Next
        Next
    End If
 End Sub

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range, temp(), n As Long, i As Long
    If Intersect(Target, Columns("m:p")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    For Each r In Intersect(Target, Columns("m:p"))
        n = n + 1
        ReDim Preserve temp(1 To 2, 1 To n)
        temp(1, n) = r.Address: temp(2, n) = r.Value
    Next
    Application.Undo: n = 0
    For Each r In Intersect(Target, Columns("m:p"))
        n = n + 1
        ReDim Preserve oldVal(1 To 2, 1 To n)
        oldVal(1, n) = r.Address: oldVal(2, n) = r.Value
    Next
    For i = 1 To n
        With Range(temp(1, i))
            .Value = temp(2, i)
            .HorizontalAlignment = IIf(.Value = "-", xlCenter, xlRight)
        End With
    Next
    Application.EnableEvents = True
 End Sub

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim temp, n As Long, i As Long
    Application.EnableEvents = False
    If Not Intersect(Target, Columns("m:p")) Is Nothing Then
        Cancel = True
        temp = oldVal
        For i = 1 To UBound(oldVal, 2)
            With Range(oldVal(1, i))
                oldVal(2, i) = .Value
                .Value = temp(2, i)
                .HorizontalAlignment = IIf(.Value = "-", xlCenter, xlRight)
            End With
        Next
    End If
    Application.EnableEvents = True
 End Sub
 (seiya)

コメント返信：

[ 一覧(最新更新順) ]

[[20130215155328]] 『セルの配置を特定文字列で変える』（みー） ページの最後に飛ぶ

[[20130215155328]]　『セルの配置を特定文字列で変える』（みー）　ページの最後に飛ぶ