マクロによって､既に値の入っているセルや空白のセルに値を追加して入れたい

Question

こんにちは

宜しければお力をお貸しください｡
A1などのセルにユーザー定義によって数字の1を(1)として入力してあり､B1も(2),C1が空白のセルだとします｡

この時､A1：C1の範囲を選択しマクロを実行することで､A1=(1)①､B1=(2)②､C1=③と指定の範囲の既に入力されている値を変えずに追加で丸数字で連番を振る方法を教えて頂きたいです｡

tatsu99 · Accepted Answer

No7です。
>条件２の設定で選択したセル１が”(2)”や”(3)”の時でも同様に(2)①、(3)①と表示されるのでしょうか？あまり詳しくないためバカなことを聞いていたらすみません…。

はい。そうなります。
以下のマクロを標準モジュールで登録し、実行してください。
---------------------------------------------------
Option Explicit

Public Sub Macro1()
    Dim maru    As Variant
    maru = Array("○", "①", "②", "③", "④", "⑤", "⑥", "⑦", "⑧", "⑨", "⑩", "⑪", "⑫", "⑬", "⑭", "⑮", "⑯", "⑰", "⑱", "⑲", "⑳")
    Dim sh1 As Worksheet
    Dim shw As Worksheet
    Dim sName As String
    Dim sa As String
    sName = ActiveSheet.Name        '選択されているシート名
    Set sh1 = Worksheets(sName)     '選択されているシートをsh1で参照する
    sa = Selection.Address          '選択されたセル領域を取得
    Worksheets.Add after:=Worksheets(Worksheets.Count)  '作業用のシートを末尾に追加（作業完了後削除する）
    Set shw = Worksheets(Worksheets.Count)  '作業用のシートをshwで参照する
    shw.Activate                    '作業用のシートをactivateする
    Dim tmp As Variant
    Dim i As Long
    tmp = Split(sa, ",")            'セルは複数選択されているので","で分割する
    For i = 0 To UBound(tmp)
        Range(tmp(i)).Value = True  '選択されたセルの該当箇所へTRUEを設定（但し作業用シートへ設定）
    Next
    ActiveCell.SpecialCells(xlLastCell).Select  '選択されたセルの最後のセルへ移動
    Dim row, col, endRow, endCol, ctr As Long
    endRow = Selection.row                      '選択されたセルの最後のセルの行を取得
    endCol = Selection.Column                   '選択されたセルの最後のセルのカラムを取得
    ctr = 0
    For row = 1 To endRow                       '1列から最後のセルの行まで繰り返し
        For col = 1 To endCol                   '1カラムから最後のセルのカラムまで繰り返し
            If Cells(row, col) = True Then      '選択されたセルの位置なら
                ctr = ctr + 1                   '番号をカウントアップ
                If ctr <= UBound(maru) Then     '番号が20以内なら
                    If ctr = 1 Then             '番号が１（先頭のセル）なら
                        sh1.Cells(row, col) = sh1.Cells(row, col) & maru(ctr)   'そのセルの内容+①を設定
                    Else
                        sh1.Cells(row, col) = maru(ctr)                         '②～⑳を設定
                    End If
                Else
                    sh1.Cells(row, col) = maru(0)   '番号が20を超えているので○を設定
                End If
            End If
        Next
    Next
    Application.DisplayAlerts = False       'シート削除時の警告を出さないようにする
    Worksheets(Worksheets.Count).Delete     '作業用のシートを削除
    Application.DisplayAlerts = True        'シート削除時の警告を出すようにする（元に戻す）
    sh1.Activate                            '選択されたシートに戻す
End Sub
--------------------------------------------------------------
セルを選択した状態で、上記のマクロを実行してください。
セルの書式は標準にしておいてください。
選択したセルの最初のセルは(1)、(2)、(3)などの文字を格納しておいてください。
入力時、(1)と入力すると-1になってしまうので、'(1)と入力してください。
(1)の前にシングルクオート「'」を付けます。そうすれば、-1と表示されません。

WindFaller · Answer

#3の回答者です。私には、なぜマクロかというものが、見えてこないままなのです。そういうものは手書きで入れるか、Wordにしたらどうでしょうか、と思ってしまうのです。マクロ自体をお求めのようにも見えますし、私の書いた数式を無視したのは、お望みではなかったからのようです。 Wordの特殊文字を入れる時の方法とは若干違いますが、例えば、m1 を、①に変換させるでも、良いのでは？確か、IMEにもそのような機能があったと思いますが、数字そのものが面倒でしょう。 Wordの場合は、U+1234 などと入れますが、こちらは、[m数字]で、同じセル内なら、まとめて変換します。Vista以上なら、50までは出せますが、それ以上は、フリーフォントをインストールしなくてはなりません。こういう方式が気に入らないのなら、無視してください。ただ、そのままにされても、どうにも治まりが付かないので、書かせていただくだけです。コードの最後に、入力の実例も示しておきます。 '//標準モジュールに貼り付けます。 '//実行するのは、「myKeySet」のみです。 '//ショートカットに登録されます。Excelが閉じればショートカットは残りません。 Private oldSentence As String Sub myKeySet()　'これを選択して実行　'ショートカット '丸付き数字に変換 Application.OnKey "^+i", "number_round" 'Ctrl + Shift -> i '元に戻す Application.OnKey "^%z", "comebackString" 'Alt + Shift -> z End Sub Private Sub number_round() '丸付き文字に変換　Dim rng As Range 　Dim sTxt As String, num, rep 　Dim Mes 　Dim m 　If TypeName(Selection) <> "Range" Then Exit Sub 　Set rng = Selection.Cells(1)　'セルは一つしかできません。　If rng.Value = "" Then Exit Sub 　 oldSentence = rng.Value 　'数値に行った場合、テキストに変わる　If IsNumeric(rng.Value) Then rng.Value = "'" & rng.Text 　sTxt = rng.Text 　With CreateObject("VBScript.RegExp") 　　.Pattern = "(m\d+)\b" 　　.Global = True 　　.IgnoreCase = False 　　If .Test(sTxt) = False Then Exit Sub 　　Set Mes = .Execute(sTxt) 　　For Each m In Mes 　　　num = Val(Mid(m.Value, 2)) 　　　If num > 0 And num < 51 Then 　　　　Select Case num 　　　　　Case Is < 21: rep = ChrW(9311 + num) 　　　　　Case Is < 36: rep = ChrW(12860 + num) 　　　　　Case Is < 51: rep = ChrW(12941 + num) 　　　　　Case Else: rep = "?" 　　　　End Select 　　　　rng.Value = Replace(rng.Value, m.Value, rep, , 1) 　　　End If 　　Next 　End With End Sub Sub comebackString() '実行したものを戻す If Len(oldSentence) > 1 Then 　 Selection.Value = oldSentence 　Else 　 MsgBox "バッファには残っていません", vbExclamation End If End Sub '----------------- 実例最初、丸付き数字のためのメタ記号を入れる　　 m数字　例:m3, m11, m30 連続すれば、 ③, ⑪, ㉚このように変わります。数は、1～50 までです。 --------------------- 例文（文章そのものは、関係がありません) 1.　名前m1をつける時にはすべて英語を基本m2としてください。英語に統一m3することによって、コードの可読性m4が向上します。 --------------------- 2.　ショートカット Ctrl+Shift -> i 名前①をつける時にはすべて英語を基本②としてください。英語に統一③することによって、コードの可読性④が向上します。 -------------------- もし戻したければ、ショートカット Ctrl + Alt -> z すると、(1) に戻ります。 --------------------- では、書式で、(1) のように、カッコつきの文字は、中身が-1 だから、入れようとすると、数式扱いになるので、そのままでは入りません。その時は、再びショートカット　Ctrl + Alt ->i とすれば、文字列に変わります。 (1) ->文字列の (1) になりますから、その後に、(1)m1 として、ショートカット　Ctrl + Alt ->i 　とすれば、 (1)①　に変わります。 m2 なら、②　に変わります。なお、ショートカットは任意に変えられます。プラス記号 "+" ..Shift カレット "^" ... Ctrl パーセント記号 "%" ... Alt ティルダ　 "~" "{Enter}" ...Enter 英字 a～z ただし、^C などは、コンフリクトするので、避けましょう。機能キーは、{ } を付けます。例えば、{F12}とします。

tatsu99 · Answer

No6です。
条件が、考慮不足でした。以下のように訂正します。
条件１：セルの書式の表示形式は標準とする。（予め標準にしておく。マクロでは表示形式は変更しない）
条件２：選択されたセル１には、そのセルの内容＋①を設定する。
（そのセルには"(1)"が設定されている前提です。
もし、そのセルには、"1"が設定されている前提にしたいなら、
セル１へは、"("＋そのセルの内容+")"+①　を設定するようにすることも可能です。）
条件３：以降の選択されたセルには、順番に、②、③、④・・・を設定する。

tatsu99 · Answer

>(１)の①の回答欄の左隅に(１)①、以降は（１）②などというのは不格好なため、②、③、④と空欄に数字だけを振りたいと考えています。

ということは、選択されたセルに
セル１＝(1)①、セル２＝②、セル３＝③、・・・
と表示させれば良いということでしょうか？
セル１、セル２、セル３の順序は、あなたが補足で述べた
>例えばA1,A2,C1,C2と選択をして実行した場合は､
>A1=①,C1=②,A2=③,C2=④と左から右､次の行の左から右へと番号を振りたいです｡
となります。

それで良ければ、
条件１：セルの書式の表示形式は標準とする。（予め標準にしておく。マクロでは表示形式は変更しない）
条件２：選択されたセル１には、(1)①を設定する。
（注意　"1①"ではなく、"(1)①"の文字を設定します。）
条件３：以降の選択されたセルには、順番に、②、③、④・・・を設定する。
という条件で、マクロを作成することは可能ですが、いかがでしょうか。

tatsu99 · Answer

No4の方の言うとおりかと思います。
空白のセルを書式設定だけで①を表示することはできません。

A1=(1)①、B1=(2)②、C1=③と指定の範囲の既に入力されている値を変えずに追加で丸数字で連番を振る方法
とのことですが、何故そのようなことをなさりたいのでしょうか？
そのようになさりたい理由、背景などを教えていただけると、別な対策があるかもしれません。

ママチャリ · Answer

現在、セルの書式設定の表示形式で、"("0")"　のような設定をされていると思います。これをマクロで、"("0")"①　に変更するということですよね。
ここまでは何の問題もなくできると思います。問題なのは、空白のセルに対して、表示形式は適用されないということです。C3セルは空白とのことですが、このセルにどんな表示形式を設定しても結局は何も表示されません。これはどうしょうもないです。この辺、どうお考えですか？

WindFaller · Answer

こんばんは。

>A1=(1)①、B1=(2)②、C1=③と指定の範囲の既に入力されている値を変えずに追加で丸数字で連番を振る方法を教えて頂きたいです。

私には、その説明をされても、ご質問が良くわからなかったです。最初から数字があるのかないのか、丸付き数字を振るなら、セルに数字などなくてもよいと思いました。

カッコ付き数字とか関係がないのではないでしょうか。丸付き数字を振るだけのことでは？ただ、マクロ処理するほどの内容だとは思えないのですが。

一旦、マクロで考えてみたけれども、元の質問から考えられるのは、なぜ、カッコ付き数字なのだろう、と考えてしまったのです。

Excelのバージョン(2013以上)に依存しますが、適当な場所に、この数式を置いて、ドラッグコピーすれば、丸付き文字が出力できますから、後は、それをコピーして、値の貼り付けをすれば出来上がります。

もし、UNICHAR関数がない場合は、VBA関数を借りてくればよいです。
標準モジュールに、このようなものを入れれば、UNICHARの数式の前にfを付けて、fUNICHAR にすればよいです。

Function fUNICHAR(arg As Variant)
　fUNICHAR = ChrW(arg)
End Function
'----------------

A　B　C　　　　　　
　1　　　2
　3　　　4
　5　　　6

=IF(A1="","",UNICHAR(9311+A1))
①　　②
③　　④
⑤　　⑥

もし、50まで出すのでしたら、以下のような数式で出せます。

=IF(A1="","",IF(A1<21,UNICHAR(9311+A1),IF(A1<36,UNICHAR(12860+A1),IF(A1<51,UNICHAR(12941+A1),""))))

なお、(1), (2) というのは、マイナス値ですから、一旦消して、普通の数字にするか、または、A1の部分をABS(A1) にするかどちらかです。

GooUserラック · Answer

可能ですが、表示形式の追加変更が結構面倒かもしれません。
時間がかかり待っています。

GooUserラック · Answer

いくつか質問があります。
① 通常丸数字は20までですが超えた場合はどうするのですか？
② 複数範囲を指定されていたときはどのように数を振っていくのですか？
③ 表示形式設定を変更するわけですよね？
④ 元々の値は「数」か「空欄」だけですか？

マクロによって､既に値の入っているセルや空白のセルに値を追加して入れたい

No7です。

#3の回答者です。

No6です。

>(１)の①の回答欄の左隅に(１)①、以降は（１）②などというのは不格好なため、②、③、④と空欄に数字だけを振りたいと考えています。

No4の方の言うとおりかと思います。

現在、セルの書式設定の表示形式で、"("0")" のような設定をされていると思います。

こんばんは。

可能ですが、表示形式の追加変更が結構面倒かもしれません。

いくつか質問があります。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

現在、セルの書式設定の表示形式で、"("0")"　のような設定をされていると思います。