Excelマクロのモジュールをそのまま貼り付け。
（会社とか家とか出先とかで見るため）
「Option Compare Binary」以下を標準モジュールに貼り付ければ、Myマクロ辞典に！
貼り付け後、「■Sub 」を「Sub 」に置き換えよう！
※公開している以上、利用は自由ですが、自己責任で。


Option Compare Binary
Option Explicit
'テキスト操作関連マクロ

■Sub ワークシート関数()
'Application.WorksheetFunction.関数　…　マクロで関数を利用する方法

Dim a As Variant
a = Application.WorksheetFunction.CountA(Range("B2:B5"))
Debug.Print a

End Sub

■Sub 最大値()

ActiveCell = Application.WorksheetFunction.Max(Range("A1"), Range("B1"), Range("C1"))

End Sub

■Sub 日時と曜日を取得()

Now '2012/12/17 10:03:45（現在のシステム日付と時刻を返す）
Date '2012/12/17（現在のシステムの時刻を返す）
Time '10:03:45（現在のシステム日付を返す）

MsgBox "今日は" & Date & "です。"


Year (Date) '指定された日時値から年を取り出して返す
Hour (Time) '指定された日時から時間の数値を返す
Minute (Time) '指定された日時から分の数値を返す
Weekday (Range("A1")) '指定された日時から曜日の数値を返す（1:日曜/2:月曜/3:火曜/4:水曜/5:木曜/6:金曜/7:土曜）
WeekdayName (Date) '指定された日時から曜日の文字列を返す
'()内は変更可　…Year(2012/12/01)　←「2012」を返す


'日時に書式を設定
i = Format(Date, "yymmdd")
i = Format(Time, "hhmmss")
Debug.Print i

'日付の確認は、cell_s「日付かどうか確認」を参照

End Sub

■Sub ふりがなを取得()
'［書式］－［ふりがな］－［表示/非表示］でふりがなが振られない場合にふりがなを振りたいセルを選択して実行

Selection.SetPhonetic
Selection.Phonetics.Visible = True
ActiveCell.Offset(1, 0).Select '下の行に移動

End Sub

■Sub ふりがなを取得_連続()
'選択したセルから最終行までのふりがなを取得

Dim i As Long
Dim x As Long 'セル番地

i = ActiveCell.Row '現在の行番号を取得
x = ActiveCell.End(xlDown).Row '最終行を取得
'MsgBox i

Do While i <= x '最終行まできたらループアウト
'Do While i < ActiveCell.End(xlDown).Row ‥アクティブセルは常に変わるのでＮＧ

Selection.SetPhonetic
Selection.Phonetics.Visible = True
ActiveCell.Offset(1, 0).Select '下の行に移動
i = i + 1
Loop

MsgBox "終了"

End Sub

■Sub 全角アルファベットと数字を半角に変換_連続()

Dim i As Long, buf As String 'マクロを実行する文字位置,マクロ実行後のテキスト
Dim r As Long '行番号
Dim x As Long 'セル番地

r = ActiveCell.Row '現在の列番号を取得
x = ActiveCell.End(xlDown).Row '最終行を取得
'MsgBox r

Do While r <= x '最終行まできたらループアウト
'1文字目から最終文字までを精査
For i = 1 To Len(ActiveCell.Value)

'全角アルファベットと数字を半角に置換
If Mid(ActiveCell.Value, i, 1) Like "[Ａ-ｚ,０-９]" Then
buf = buf & StrConv(Mid(ActiveCell.Value, i, 1), vbNarrow)
Else
buf = buf & Mid(ActiveCell.Value, i, 1)
End If

Debug.Print buf
Next i

'最終文字まで精査が終了したら、精査後の文字列に置換
ActiveCell.Value = buf
buf = ""

ActiveCell.Offset(1, 0).Select '下の行に移動
r = r + 1
Loop

MsgBox "全角アルファベットと数字を半角に変換しました。　　　" & vbNewLine & "(= ゜▽ ゜=)v"

End Sub

■Sub 半角アルファベットと数字を全角に変換_連続()

Dim i As Long, buf As String 'マクロを実行する文字位置,マクロ実行後のテキスト
Dim r As Long '行番号
Dim x As Long 'セル番地

r = ActiveCell.Row '現在の列番号を取得
x = ActiveCell.End(xlDown).Row '最終行を取得
'MsgBox r

Do While r <= x '最終行まできたらループアウト
'1文字目から最終文字までを精査
For i = 1 To Len(ActiveCell.Value)

'半角アルファベットと数字を全角に置換
If Mid(ActiveCell.Value, i, 1) Like "[A-z,0-9]" Then
buf = buf & StrConv(Mid(ActiveCell.Value, i, 1), vbWide)
Else
buf = buf & Mid(ActiveCell.Value, i, 1)
End If

Debug.Print buf
Next i

'最終文字まで精査が終了したら、精査後の文字列に置換
ActiveCell.Value = buf
buf = ""

ActiveCell.Offset(1, 0).Select '下の行に移動
r = r + 1
Loop

MsgBox "半角アルファベットと数字を全角に変換しました。　　　" & vbNewLine & "(￣ー￣)v"

End Sub

■Sub 半角カタカナを全角に変換_連続()

Dim i As Long, buf As String 'マクロを実行する文字位置,マクロ実行後のテキスト
Dim r As Long '行番号
Dim x As Long 'セル番地

r = ActiveCell.Row '現在の列番号を取得
x = ActiveCell.End(xlDown).Row '最終行を取得
'MsgBox r

Do While r <= x '最終行まできたらループアウト
'1文字目から最終文字までを精査
For i = 1 To Len(ActiveCell.Value)

'半角カナを全角に置換
If Mid(ActiveCell.Value, i, 1) Like "[ｱ-ﾝ,ｧ,ｨ,ｩ,ｪ,ｫ,ｯ,ｬ,ｭ,ｮ,ｰ]" Then
buf = buf & StrConv(Mid(ActiveCell.Value, i, 1), vbWide)
Else
buf = buf & Mid(ActiveCell.Value, i, 1)
End If

'濁音、半濁音を正しく置換
If Right(buf, 1) Like "［ﾞ,ﾟ］" Then
buf = Left(buf, Len(buf) - 2) & StrConv(StrConv(Right(buf, 2), vbNarrow), vbWide)
End If

Debug.Print buf
Next i

'最終文字まで精査が終了したら、精査後の文字列に置換
ActiveCell.Value = buf
buf = ""

ActiveCell.Offset(1, 0).Select '下の行に移動
r = r + 1
Loop

MsgBox "半角カタカナを全角に変換しました。　　　" & vbNewLine & "(* ゜ー ゜*)v"

End Sub

■Sub 文字数を取得()
'指定した文字列の中から引数で指定した文字列を検索して見つかった（文頭からの）位置を返す

MsgBox InStr("ABCDEFde", "de") '文字列の文頭（左）から検索して最初見つかった（文頭からの文字）位置「4」を返す

MsgBox InStrRev("ABCdeFde", "de") '文字列の文末（右）から検索して最初見つかった（文頭からの文字）位置「7」を返す


'◆InStr関数の戻り値一覧
'長さ0の文字列("")のとき　　　　　　 0
'文字列がNull値のとき　　　　　　　　 　　　Null 値
'検索文字列が長さ0の文字列("")のとき　　　 start
'検索文字列がNull値のとき　　　　　　　 Null 値
'検索文字列が見つからないとき 0
'検索文字列が検索文字列が見つかったとき 見つかった文字列の位置

End Sub

■Sub 指定した文字数を取り出す()

Dim x As Variant
x = "アセアン交通分野"
MsgBox LeftB(x, 10)
MsgBox Left(x, 5)
MsgBox StrConv(LeftB(StrConv(x, vbFromUnicode), 10), vbUnicode)

'Office97以降、文字コードがANSI形式からUnicode形式に変わったため、半角の文字であっても2バイト文字として扱われるようになった。
'以下の関数を使う際には､対象の文字列をStrConv関数を利用し､データをUnicodeに変換する｡
'→　Asc、Chr、InputB、InStrB、LeftB、LenB、RightB、Midb

'LeftB(x, 文字数) 'ANSI形式の状態で任意のバイト数取得
'StrConv(x, vbFromUnicode) 'Unicode形式をANSI形式に変換
'StrConv(x, vbUnicode) 'ANSI形式をUnicode形式に変換

End Sub

■Sub 改行コードとその他のコード()

vbCrLf
vbNewLine
Chr (10)

'ダブルクォーテーション（"）
Chr (34)

End Sub

■Sub 改行コードを探す()

Dim buf As String
buf = Replace(ActiveCell, vbLf, "") '改行コードを削除
MsgBox buf

buf = InStr(ActiveCell, vbLf) '改行コードの位置（存在）を取得（ない場合は0を返す）
MsgBox buf

'【参考】改行コードの定数
'16進の0D → vbCr
'16進の0A → vbLf Excelデータ
'16進の0D+0A → vbCrLf 一般的なテキストデータ

End Sub

■Sub 改行コードの置き換え()

Dim buf As String
buf = Replace(ActiveCell, vbLf, "")
MsgBox buf

End Sub

■Sub 改行コードでセル分割する()

Dim i As Long
Dim Ary
Ary = Split(Range("A1").Value, Chr(10))
For i = 0 To UBound(Ary)
Range("B2").Offset(i, 0).Value = Ary(i)
Next i

End Sub
■Sub 文字列の置き換え()
'Replace(対象文字列, 検索文字列, 置換文字列, 検索開始位置を指定(省略時は1), 置換回数(省略時は全て置換), 比較モードを指定(※1) )

x = "おかあさん"
x = Replace(x, "かあ", "とう", , 1)
MsgBox "x" '「おとうさん」と表示される


'※1　指定する比較モードを表す定数一覧（VbCompareMethod）

'定数　　　　　　　　　　値　　　説明

'vbUseCompareOption　　　-1　　　Option Compare ステートメントの設定を使用して比較
'vbBinaryCompare　　　　　0　　　バイナリ モードの比較
'vbTextCompare　　　　　　1　　　テキスト モードの比較
'vbDatabaseCompare　　　　2　　　Microsoft Access の場合のみ有効。データベースに格納

End Sub

■Sub 文字列の置き換え_スペース()
'余分なスペースの削除

Range("A7") = Application.WorksheetFunction.Trim("　　渋　　谷　　") '渋　谷 …アプリケーション関数は、文中のスペースも整理される
Range("A8") = Trim("　　渋　　谷　　") '渋　　谷 …VBA関数は、前後のみ削除する

End Sub

■Sub データのカウント()

Dim cnt As Long
cnt = WorksheetFunction.CountIf(ActiveSheet.Range("A1:A11"), "A001")
MsgBox "A001は、" & cnt & "件です。", vbInformation

End Sub

■Sub コピーや切り取りを取り消し()
'クリップボードのクリア？

Excel.Application.CutCopyMode = False

End Sub

■Sub データ型の変換とwith()
'書式設定

'◆数値を文字列に変換
Range("B11").NumberFormatLocal = "@" '先に書式を「文字列」に変更する
Range("B11") = Range("B12")

With Range("A1")
.NumberFormatLocal = "@" '先に書式を「文字列」に変更する（Withを使う）
.Value = Range("A2")
End With

Range("B11") = CStr(Range("B12")) 'その場で「文字列」に変更する

'◆変数aに「エラー 2042」がある場合（関数式のエラーなど）、文字列に変更する
If CStr(a) = "エラー 2042" Then MsgBox "エラー" Else MsgBox "正常"
'msgboxに「エラー」が返る


'◆文字列を数値に変更
Range("B12").NumberFormatLocal = "0" '先に書式を「数値」に変更する
Range("B12") = Range("B12").Value '「.Value」で数値に変更される

'Range("B12") = CVar(Range("B12")) 'これでもいけるはずだがダメだった‥


'
Range("B10") = Format("2014/4/1", "yy/mm/dd/aaa") '"2014/4/1"を"14/4/1/火"に
Range("B10") = Format(Range("B10"), "yy/mm/dd/aaa") '"2014/4/1"を"14/4/1/火"に


'◆セル色の指定
ActiveCell.Interior.ColorIndex = 7
'色番号参考http://www.happy2-island.com/excelsmile/smile03/capter00602.shtml

'◆四捨五入
Range("C1").Value = WorksheetFunction.Round(10.5, 0)
'VBAのRound関数は四捨五入ではなく「通貨型丸め処理」「銀行型丸め処理」などと呼ばれ、
'「0.5」のときは丸めた結果が偶数になるように丸められるので使用は避ける。

'◆太字にする
Range("A1").Font.Bold = True

'◆一度に書式変更
With Range("A1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With

With Range("A1").Font
.Name = "ＭＳ 明朝"
.ColorIndex = 7
.Size = 100
.Bold = True
.Italic = True
.Underline = xlUnderlineStyleSingle
End With

End Sub

NAME:

MAIL:

URL:

COLOR:
Black LimeGreen SeaGreen Teal FireBrick Tomato IndianRed BurlyWood SlateGray DarkSlateBlue LightPink DeepPink DarkOrange Gold DimGray Silver
SUBJECT:

COMMENT:


PASS: