念仏寺とフォルクローレトップページに戻ります

エクセルVBA4「追加・削除する」

モジュールのソースをボタンでコピーできるようにしました。ホームページに載っているソースをコピーしようとしてドラッグしかけて、うまく全体がコピーできなかったことを今まで何度も経験していると、簡単にコピーできるほうがありがたい。そんな思いで一括コピーするボタンをつけてみました。もちろん私はエクセルVBAといっても本で読んだり、他の人のHPを参考にしながら、自分が利用しそうなものをまとめているだけで、自分なりに手を加えている箇所は非常に少ないだろうと思います。

エクセルVBAのマクロの記述モジュールは緑の枠内に記述しています。｢モジュールをコピーする｣のボタンをクリックすると、このモジュール全体を一発でコピーします。それを貼り付けてマクロを実行してみてください。


「エクセルVBA事始め」に戻る


このページの目次



１　ふりがなを同一セルに追加 (2006,2,28)

２　右列文字をふりがなに追加 (2006,2,28)

３　フリガナを右列に表示 (2006,2,28)

４　範囲内の文字列先頭末尾スペースを削除 (2006,2,28)

５　範囲内文字列内の半角スペースを削除 (2006,2,28)

６　範囲内文字列の全スペースを削除 (2006,2,28)

７　範囲のセル内上下左に余白を設ける(2009,10,4)

７b　範囲のセル内上下左に余白を設ける(2009,10,6)

　 ８　対象内に任意文字後追加(2009,10,4)

９　対象内に任意文字前追加(2009,10,4)

１０　対象内の任意文字削除(2009,10,4)

１１　指定文字に均等割りルビを追加(2015,12,20)

１２　複数の文字列に均等割りルビを追加(2015,12,27)



◆◆◆　1　ふりがなを同一セルに追加 ◆◆◆

ふりがなをつけたいセルを選択して、このマクロを実行すると、ふりがなが設定できる。ただし、他のシートなどからコピーして張り付けたデータだと、振り仮名は表示できない。このマクロのときは必ず直接入力したセルに限る。

利用するときには、変換したいところを選択してからマクロの実行をする。


Sub ふりがなを同一セルに追加()
' マクロ記録日 : 2004/12/29  ユーザー名 : canchan
'ふりがなを設定したいところを範囲指定してから実行する。

Dim 対象 As Range
For Each 対象 In Selection
Selection.SetPhonetic
Next 対象
'
End Sub
モジュールをコピーする


このページの目次に戻る


◆◆◆　2　右列文字をふりがなに追加　◆◆◆

１の「ふりがなを同一セルに追加」はセルに入力してある情報からのふりがな追加ですが、この２はふりがなを追加するセルを選択すると、その右のセルの値（ひらがな、カタカナ、アルファベット、漢字などどんな値でも）をふりがなとして追加することができる。またふりがなを設定しても後で間違いを訂正するときも、細かいルビを直すより、隣の列に入力されている値を訂正してこのマクロを実行すると、楽である。 


Sub 右列文字をふりがなに追加()
' マクロ記録日 : 2004/12/29  ユーザー名 : canchan
'
Dim 対象 As Range	'選択された領域を「対象」としている。
Dim ふりがな As String

For Each 対象 In Selection
ふりがな = 対象.Offset(0, 1).Value	'「対象」の１列右Offset(0, 1)が「ふりがな」である。
If ふりがな = "" Then
対象.Activate
MsgBox "ふりがなデータがありません。"
Exit Sub
End If
対象.Phonetic.Text = ふりがな
Next 対象

End Sub


モジュールをコピーする


このページの目次に戻る


◆◆◆　3　フリガナを右列に表示　◆◆◆


Sub フリガナを右列に表示()
' フリガナを右列に表示 Macro
' マクロ記録日 : 2005/1/7  ユーザー名 : canchan
Dim taisyo As Range
For Each taisyo In Selection
taisyo.Offset(0, 1).Value = Application.GetPhonetic(taisyo)     '「対象」の右列の値は「対象」のふりがなですよ
Next taisyo
'
End Sub
モジュールをコピーする


このページの目次に戻る


◆◆◆　４　範囲内の文字列先頭末尾スペースを削除　◆◆◆


Sub 範囲内の文字列先頭末尾スペースを削除()
Dim 対象 As Range　　　　　　　’
For Each 対象 In Selection
    For Each セル In ActiveSheet.UsedRange      '現在シートの使われたセル範囲の各セルに対して
        セル.Value = Trim(セル.Value)           '先頭と末尾の両方のスペースを削除する
    Next                                        '繰り返す
End Sub
モジュールをコピーする


このページの目次に戻る


◆◆◆　５　範囲内文字列内の半角スペースを削除 ◆◆◆


Sub 範囲内文字列内の半角スペースを削除()
Dim 対象 As Range
For Each 対象 In Selection
    For Each セル In ActiveSheet.UsedRange      '現在シートの使われたセル範囲の各セルに対して
        セル.Value = Replace(セル.Value, " ", "")         '文字列内の半角スペースを削除する
    Next                                        '繰り返す
End Sub
モジュールをコピーする


このページの目次に戻る


◆◆◆　６　範囲内文字列の全スペースを削除 ◆◆◆


Sub 範囲内文字列の全スペースを削除()
    For Each セル In ActiveSheet.UsedRange      '現在シートの使われたセル範囲の各セルに対して
'        セル.Value = Trim(セル.Value)           '先頭と末尾の両方のスペースを削除する
        セル.Value = Replace(セル.Value, " ", "")         '文字列内の半角スペースを削除する
        セル.Value = Replace(セル.Value, "　", "")         '文字列内の全角スペースを削除する
    Next                                        '繰り返す
End Sub
モジュールをコピーする


このページの目次に戻る


◆◆◆　７　範囲のセル内上下左に余白を設ける ◆◆◆

(2009,10,5)

１つのセルに多くの文字列を記入することがある。エクセルの書式設定で「文字列の折り返し」をして確かに画面上はすべての文字が表示できていても、いざ印刷すると最後の行などが罫線で隠れて見えなくなってしまうことがよくある。

解決するためにセル内の上下にスペースと改行を設定し、左側も１文字分のインデントを設置するマクロを考えてみた。これで入力した文字列を１行も隠れることなく印刷することができる。


Sub 範囲のセル内上下左に余白()
Dim 対象 As Range              '
For Each 対象 In Selection
'    For Each セル In ActiveSheet.UsedRange      		'現在シートの使われたセル範囲の各セルに対して
        対象.Replace what:=Chr(10), replacement:=""     	'改行マーク「Chr(10)」を削除
        対象.Value = Trim(対象.Value)           		'先頭と末尾の両方のスペースを削除する
        対象.Value = "" & Chr(10) & 対象.Value & Chr(10) & ""   '先頭と末尾の両方に改行を入れる
        対象.WrapText = True    				'文字の折り返し
        対象.IndentLevel = 1    				'インデントの設定。「１」は１文字左から下げる。
    Next    							'繰り返す

End Sub
モジュールをコピーする




このページの目次に戻る






◆◆◆　７b　範囲のセル内上下左に余白を設ける ◆◆◆

(2009,10,5)

７で作ったマクロでは空白セルにも同様の空白を作ってしまうため行の幅が広がってしまう。それを指定した範囲の中でセルの中に入力してあるところだけを余白を設けるように改善する。

解決するためにセル内の上下にスペースと改行を設定し、左側も１文字分のインデントを設置するマクロを考えてみた。これで入力した文字列を１行も隠れることなく印刷することができる。


Sub 範囲の記入セル内上下左に余白()
Dim 対象 As Range              '
For Each 対象 In ActiveSheet.UsedRange             '現在シートの使われたセル範囲の各セルに対して
        対象.Replace what:=Chr(10), replacement:=""         '改行マーク「Chr(10)」を削除
        対象.Value = Trim(対象.Value)                   '先頭と末尾の両方のスペースを削除する
        対象.Value = "" & Chr(10) & 対象.Value & Chr(10) & ""   '先頭と末尾の両方に改行を入れる
        対象.WrapText = True                    '文字の折り返し
        対象.IndentLevel = 1                    'インデントの設定。「１」は１文字左から下げる。
    Next                                '繰り返す

End Sub
モジュールをコピーする




このページの目次に戻る






◆◆◆　８　対象内に任意文字後追加 ◆◆◆

(2009,10,5)

エクセルで表を作成した後で、氏名の最後に「様」「氏」「さん」「番地」「円」などの語を追加したいと思うことがある。

一つ二つなら追加したい位置をダブルクリックするとその位置にカーソルがあうから「様」などの語を入力してもよい。ただ多くなるととてもできない。そんな時このマクロが便利な働きをしてくれる。これは選択している範囲内の各セルの値（氏名など文字・数字）の最後に追加するものです。値のすぐ後に追加されるので、追加文字を入力するときに「半角（あるいは全角）スペース追加文字」と入力しておくのも見やすいかもしれません。


Sub 対象内に任意文字後追加()
' マクロ記録日 : 2005/3/16  ユーザー名 : canchan
Dim 対象 As Range
Dim 文字 As String
文字 = InputBox("追加文字を入力してください。", "追加文字入力")
For Each 対象 In Selection
対象.Value = 対象.Value & 文字
Next 対象
End Sub
モジュールをコピーする




このページの目次に戻る






◆◆◆　９　対象内に任意文字前追加 ◆◆◆

(2009,10,5)

エクセルで表を作成した後で、セル内の文字列・数字の頭のところに「●」「一金」「→」などの語・記号を追加したいと思うことがある。

一つ二つなら追加したい位置をダブルクリックするとその位置にカーソルがあうから「●」などの語を入力してもよい。ただ多くなるととてもできない。そんな時このマクロが便利な働きをしてくれる。これは選択している範囲内の各セルの値（氏名など文字・数字）の最初（頭）に追加するものです。値（文字列）のすぐ前に追加されるので、追加文字を入力するときに「追加文字」の後に「半角（あるいは全角）スペース」を入力しておくのも見やすいかもしれません。


Sub 対象内に任意文字追加()
' マクロ記録日 : 2005/3/16  ユーザー名 : canchan
Dim 対象 As Range
Dim 文字 As String
文字 = InputBox("追加文字を入力してください。", "追加文字入力")
For Each 対象 In Selection
対象.Value = 文字 & 対象.Value
Next 対象
End Sub
モジュールをコピーする




このページの目次に戻る






◆◆◆　１０　対象内の任意文字削除 ◆◆◆

(2009,10,5) 


Sub 削除任意文字対象内()
' マクロ記録日 : 2005/3/16  ユーザー名 : canchan
Dim 対象 As Range
Dim 文字 As String
文字 = InputBox("削除文字を入力してください。", "削除文字入力")
For Each 対象 In Selection
対象.Replace what:=文字, replacement:=""

Next 対象
End Sub
モジュールをコピーする




このページの目次に戻る






◆◆◆　１１　指定文字列に均等割りルビを付ける ◆◆◆

(2015,12,20)

セル内のある文字列だけにルビを打ちたい。ところがエクセルでセルを振り仮名設定をすると、すべての漢字にルビが入ってしまい、それ以外の漢字のルビを一つずつ削除していかなければならず、大変手間がかかる。そこである漢字列だけにルビを打つことを考えて見た。同じ文字列が出ても最初だけにルビを振る。これは俳句をまとめていて一つだけにルビを打つ手間が大変なことを実感したことから考えることにした。複数語句については後の事にしたい。

漢字と書いたが、これはひらがなに英単語をとか、どのような組み合わせでも可能です。

　写真のようなサンプル：こちら 

Sub 文字列に均等ふりがな()
'ふりがなを入れたい文字が含まれるセルを選択する
'C3にふりがなを付けたい漢字を入れる
'C4にそのふりがなを書く
    Dim C As Long       'Cは検索文字の文字数
    Dim N As Long   'Nは検索する文字が何文字目かを示す
    
    Selection.Phonetics.Visible = True
    Selection.Phonetics.CharacterType = xlHiragana
    Selection.Phonetics.Alignment = xlPhoneticAlignDistributed  '振り仮名を均等割り
'    Selection.Phonetics.Alignment = xlPhoneticAlignLeft    '振り仮名を左寄せ
    ActiveCell.Phonetics.Delete  '選択しているセルの振り仮名を削除する
    C = Len(Range("C3"))
    N = InStr(ActiveCell, Range("C3"))
        'Nは検索する文字が何文字目かを示す。
   '  MsgBox N      'A3の文字の位置を数字で示せている。
         ActiveCell.Characters(N, C).PhoneticCharacters = Range("C4").Value
'Characters(N, C) はセルのN字目からC文字分かを示している。
End Sub
モジュールをコピーする


◆◆◆　１２　複数の文字列に均等割りルビを追加 ◆◆◆

(2015,12,27)

11ではセル内の1つの文字列だけにルビを打つことができた。ところが俳句をまとめていて一つの俳句に複数の文字列にルビを打つことが必要になることがある。そこで次のようなマクロを作ってみた。

漢字と書いたが、これはひらがなに英単語をとか、どのような組み合わせでも可能です。ここではルビは「ひらがな」、文字列に対して「均等割り付け」のルビにする、指定のセルのフォントサイズの「半分のサイズ」のルビにする。

サンプルファイル(エクセルのマクロ有効ファイル)17.5kbです。 

Sub 複数語句に均等ルビ()
'ふりがなを入れたい文字が含まれるセルを選択する
'C3にふりがなを付けたい漢字を入れる
'C4にそのふりがなを書く
    Dim i As Integer    'ルビ変数
    Dim cnt As Integer  'ルビを付けたい漢字数
    Dim C As Long       'Cは検索文字の文字数
    Dim N As Long   'Nは検索する文字が何文字目かを示す
    Selection.Phonetics.Visible = True
    Selection.Phonetics.CharacterType = xlHiragana
    'Selection.Phonetics.Font.Size = 12
    Selection.Phonetics.Font.Size = ActiveCell.Font.Size / 2
    Selection.Phonetics.Alignment = xlPhoneticAlignDistributed  '振り仮名を均等割り
'    Selection.Phonetics.Alignment = xlPhoneticAlignLeft    '振り仮名を左寄せ
    ActiveCell.Phonetics.Delete  '選択しているセルの振り仮名を削除する
    cnt = Range("C3", Range("C3").End(xlToRight)).SpecialCells(xlCellTypeVisible).Count
    'MsgBox "ルビの必要な語句は： " & cnt & "個です"
    For i = 0 To cnt
    C = Len(Cells(3, 3 + i))
    N = InStr(ActiveCell, Cells(3, 3 + i))
        'Nは検索する文字が何文字目かを示す。
   '  MsgBox N      'A3の文字の位置を数字で示せている。
         ActiveCell.Characters(N, C).PhoneticCharacters = Cells(4, 3 + i).Value
'Characters(N, C) はセルのN字目からC文字分かを示している。
    Next i
End Sub
モジュールをコピーする




このページの目次に戻る




「エクセルVBA事始め」に戻る