VBAでのイニシャルの自動作成

カタカナで名字と名前がそれぞれセットされています。これから
イニシャルを自動的に作るマクロを作りたいと思うのですが
どうやれば良いでしょうか？VBA初心者です。よろしくお願いします。


Ａ　　　Ｂ　　　Ｃ
タナカ　タロウ

上の様なものから

Ａ　　　Ｂ　　　Ｃ
タナカ　タロウ　T.T

・・・と作りたいのです。

No.2 ベストアンサー 回答者： ASIMOV 回答日時： 2007/02/28 13:18

＞今回はＣＳＶファイルを読み込んでその時に自動的にイニシャルを

＞ふりたいと思ったので自動的にやってみたいのです

ＶＢＡの場合です
--------------------------
Sub TEST()
　l = 1
　Do While Cells(l, 1) <> ""
　　sei = Initial(Left(Cells(l, 1), 1))
　　mei = Initial(Left(Cells(l, 2), 1))
　　Cells(l, 3) = sei & "." & mei
　　l = l + 1
　Loop
End Sub
---------------
Function Initial(x)
　Select Case x
　　Case "ア", "イ", "ウ", "エ", "オ"
　　　Initial = "A"
　　Case "カ", "キ", "ク", "ケ", "コ"
　　　Initial = "K"
　　Case "サ", "シ", "ス", "セ", "ソ"
　　　Initial = "S"
　　Case "タ", "チ", "ツ", "テ", "ト"
　　　Initial = "T"
　　Case "ナ", "ニ", "ヌ", "ネ", "ノ"
　　　Initial = "N"
　　Case "ハ", "ヒ", "フ", "ヘ", "ホ"
　　　Initial = "H"
　　Case "マ", "ミ", "ム", "メ", "モ"
　　　Initial = "M"
　　Case "ヤ", "ユ", "ヨ"
　　　Initial = "Y"
　　Case "ラ", "リ", "ル", "レ", "ロ"
　　　Initial = "R"
　　Case "ワ", "ヲ"
　　　Initial = "W"
　　Case Else
　　　Initial = ""
　End Select
End Function

この回答へのお礼

これは分りやすいですね。
希望しているものでした。

ありがとうございます。助かりました。

お礼日時：2007/02/28 13:56

No.3 回答者： Wendy02 回答日時： 2007/02/28 13:36

こんにちは。

以下は、チは、T となっていますが、C ということもあります。その場合は、以下のリストの中を数えて、28番目の 'T' を変更してください。ユーザー定義関数のみでも、使用可能です。
例：=InitialCap(A1,B1) 逆さにする場合は、
=InitialCap(A1,B1,True) とすれば、逆さになります。もちろん、セルで逆さにしても良いです。これは、マクロのためにあります。

標準モジュールに設定してください。
データの範囲のセルに、マウスカーソルを置いて、マクロ(HenKanInital)を実行してください。

ショートカットなどに設定すると便利かもしれません。なお、リストは、掲示板アップロード用で、本来は、"& _" は、なくても、一行でも支障はありません。そのほうが読みやすいかもしれません。

'--------------------------------------------------------------------------


'Option Explicit

Private Const HIRA As String = _
"ア,イ,ウ,エ,オ,カ,ガ,キ,ギ,ク,グ,ケ,ゲ,コ,ゴ," & _
"サ,ザ,シ,ジ,ス,ズ,セ,ゼ,ソ,ゾ,タ,ダ,チ,ヂ,ツ,ヅ," & _
"テ,デ,ト,ド,ナ,ニ,ヌ,ネ,ノ,ハ,バ,パ,ヒ,ビ,ピ,フ,ブ," & _
"プ,ヘ,ベ,ペ,ホ,ボ,ポ,マ,ミ,ム,メ,モ,ヤ,ユ,ヨ,ラ,リ,ル," & _
"レ,ロ,ワ,ヰ,ヱ,ヲ,ン,ヴ"
Private Const ALPHA As String = _
"A,I,U,E,O,K,G,K,G,K,G,K,G,K,G,S,Z,S,J,S,Z,S,Z,S,Z," & _
"T,D,T,J,T,D,T,D,T,D,N,N,N,N,N,H,B,P,H,B,P,F,B,P,H,B," & _
"P,H,B,P,M,M,M,M,M,Y,Y,Y,R,R,R,R,R,W,W,W,W,N,V"
Private Hiras As Variant
Private Alphas As Variant
Public Function InitialCap(Str1 As Range, Str2 As Range, Optional Reversed As Boolean)
'イニシャルを出力する関数
　　Dim i As Variant
　　Dim j As Variant
　　Dim oAlp1 As String
　　Dim oAlp2 As String
　　
　　Hiras = Split(HIRA, ",")
　　Alphas = Split(ALPHA, ",")
　　If VarType(Str1.Value) = vbString Then
　　
　　　　Str1 = StrConv(Str1, vbWide + vbKatakana)
　　　　On Error Resume Next
　　　　i = Empty
　　　　i = WorksheetFunction.Match(Left$(Str1, 1), Hiras, 0)
　　　　On Error GoTo 0
　　　　If i > 0 Then
　　　　　　oAlp1 = Alphas(i - 1) & "."
　　　　End If
　　End If
　　If VarType(Str2.Value) = vbString Then
　　　　Str2 = StrConv(Str2, vbWide + vbKatakana)
　　　　On Error Resume Next
　　　　j = Empty
　　　　j = WorksheetFunction.Match(Left$(Str2, 1), Hiras, 0)
　　　　On Error GoTo 0
　　　　If j > 0 Then
　　　　　　oAlp2 = Alphas(j - 1) & "."
　　　　End If
　　End If
　　
　　If Reversed Then
　　　　InitialCap = oAlp2 & oAlp1
　　Else
　　　　InitialCap = oAlp1 & oAlp2
　　End If

End Function

Sub HenKanInital()
'実行マクロ
Dim rng As Range
Dim c As Range
Const MCOL As Integer = 3 '出力列
If TypeName(Selection) <> "Range" Then Exit Sub
Set rng = Selection.CurrentRegion.Columns(1).Resize(, 2)
If WorksheetFunction.CountA(rng) < 2 Then MsgBox "場所が違いませんか？": Exit Sub
Application.ScreenUpdating = False
If rng.Columns.Count <> 2 Then MsgBox "2列でありません。2列を選択してください": Exit Sub
For Each c In rng.Columns(1).Cells
　c.Offset(, MCOL - 1).Value = InitialCap(c, c.Offset(, 1))
Next c
Application.ScreenUpdating = True
End Sub

この回答へのお礼

これはすごいですね。ちゃんとエラー処理まであります！

ありがとうございます。参考にさせていただきます。

お礼日時：2007/02/28 13:57

No.1 回答者： ASIMOV 回答日時： 2007/02/28 11:36

それなら、テーブルとＶＬＯＯＫＵＰでも出来ますよ

C1=VLOOKUP(LEFT(A1,1),E1:F10,2) & "." & VLOOKUP(LEFT(B1,1),E1:F10,2)

テーブルは
E1="ア"
F1="A"
E2="カ"
E2="K"
と言う具合に E3～F10 に続きを記入

この回答へのお礼

早速のご回答ありがとうございます。
なるほどこれだと可能ですね。

今回はＣＳＶファイルを読み込んでその時に自動的にイニシャルを
ふりたいと思ったので自動的にやってみたいのです。

できるでしょうか？

お礼日時：2007/02/28 11:45