[[20170814194333]] 『先頭文字の変更について』(KK) ページの最後に飛ぶ

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

 

『先頭文字の変更について』(KK)

よろしくお願いします
H10,I10,J10,K10,L10,M10,N10に
それぞれ
□鈴木 □山田 □加藤 □佐藤 □田中 □田口 □丸山
が入力されておりダブルクリックで一文字のみ変更させることは可能でしょうか
■鈴木 ■山田 ■加藤・・・のように
各セル個々にダブルクリックで変更する。

2回目のダブルクリックでまた元に戻す。
以下のケースでは鈴木限定となってしまうためそれぞれのマクロが
必要なため長文で書かなくては利用できない(変)
各セル共通のマクロでできるようであれば御教授お願いします。

Set k = Intersect(Range("H10"), Target)

    If Not k Is Nothing Then
  With k
    Select Case .Value
    Case "□鈴木"
      Target.Value = "■鈴木"
    Case "■鈴木"
      Target.Value = "□鈴木"
    End Select
  End With

< 使用 Excel:Excel2016、使用 OS:Windows10 >


 最初(一番左)の一文字で判定してはいかがでしょう?

 If Left(Target.Value, 1) = "□" Then
    Target.Value = "■" & Right(Target.Value, Len(Target.Value) - 1)
 ElseIf Left(Target.Value, 1) = "■" Then
    Target.Value = "□" & Right(Target.Value, Len(Target.Value) - 1)
 End If
(カリーニン) 2017/08/14(月) 20:13

 コード全体を纏めるとこんな感じになります。

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Intersect(Target, Range("h10:n10")) Is Nothing Then Exit Sub
  Cancel = True
  If Left(Target.Value, 1) = "□" Then
      Target.Value = "■" & Right(Target.Value, Len(Target.Value) - 1)
   ElseIf Left(Target.Value, 1) = "■" Then
      Target.Value = "□" & Right(Target.Value, Len(Target.Value) - 1)
   End If
 End Sub
(カリーニン) 2017/08/14(月) 20:23

 セルの文字列ではなく、シェイプを配置したらシェイプクリックで背景色を切替えることができます。

 シェイプに↓を登録してシェイプをクリックしたら、背景色が白色の場合は黒色に、黒色の場合は
 白色に切り替わります

 Sub shpcolor()
  With ActiveSheet.Shapes(Application.Caller)
   If .Fill.ForeColor.RGB = vbBlack Then
      .Fill.ForeColor.RGB = vbWhite
   ElseIf .Fill.ForeColor.RGB = vbWhite Then
      .Fill.ForeColor.RGB = vbBlack
   End If
  End With
 End Sub
(カリーニン) 2017/08/14(月) 20:35

 >ダブルクリックで一文字のみ変更させることは可能でしょうか 

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
     Dim myRect As String
     If Intersect(Target, Range("h19:n10")) Is Nothing Then Exit Sub
     Cancel = True
     myRect = IIf(Target.Value Like "□*", "■", IIf(Target.Value Like "■*", "□", ""))
     If Len(myRect) Then Target.Value = Application.Replace(Target.Value, 1, 1, myRect)
 End Sub
(seiya) 2017/08/14(月) 20:53

(カリーニン)さん
速攻ありがとうございました。
希望通りできました。
尚、Sub shpcolor()ですが今回の内容では
利用方法が難しいですが、いろんな場面で
利用できそうです。後々利用させてください。

(seiya)さん
ありがとうございました。
マクロの書き方参考になりました。
特にLike演算子少し検索し勉強させていただきます。

(KK) 2017/08/15(火) 00:43


コメント返信:

[ 一覧(最新更新順) ]


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