Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

32322 / 76734

←次へ　｜　前へ→


	【49650】Re:半角カナでも小さいカナを大きいカナに一括変換したい

Hirofumi - 07/6/14(木) 17:52 -


	引用なし

	パスワード

セルポインタの有る列で、セルポインッタ以下を変換します

Option Explicit

Public Sub Sample()

　　Dim i As Long
　　Dim lngRows As Long
　　Dim rngList As Range
　　Dim vntData As Variant
　　Dim strProm As String

　　'◆Listの先頭セル位置を基準とする（A列の列見出しのセル位置）
　　Set rngList = ActiveCell

　　With rngList
　　　　'行数の取得
　　　　lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row + 1
　　　　If lngRows <= 1 And .Value = "" Then
　　　　　　strProm = "データが有りません"
　　　　　　GoTo Wayout
　　　　End If
　　　　'列データを配列に取得
　　　　vntData = .Resize(lngRows + 1).Value
　　End With

　　'データ全てに就いて繰り返し
　　For i = 1 To lngRows
　　　　'変換
　　　　vntData(i, 1) = KanaConv(vntData(i, 1))
　　Next i

　　'画面更新を停止
　　Application.ScreenUpdating = False

　　'出力
　　rngList.Resize(lngRows).Value = vntData

　　strProm = "処理が完了しました"

Wayout:

　　'画面更新を再開
　　Application.ScreenUpdating = True

　　Set rngList = Nothing

　　MsgBox strProm, vbInformation
　　　　　
End Sub

Private Function KanaConv(ByVal vntValue As Variant) As Variant

　　Dim i As Long
　　Dim vntFind As Variant
　　Dim vntReplace As Variant
　　
　　'小さいカタカナを大きいカタカナに
　　vntFind = Array(Chr(&HA7), Chr(&HA8), _
　　　　　　　　　　Chr(&HA9), Chr(&HAA), Chr(&HAB), Chr(&HAC), _
　　　　　　　　　　Chr(&HAD), Chr(&HAE), Chr(&HAF))
　　vntReplace = Array(Chr(&HB1), Chr(&HB2), Chr(&HB3), _
　　　　　　　　　　　　Chr(&HB4), Chr(&HB5), Chr(&HD4), Chr(&HD5), _
　　　　　　　　　　　　Chr(&HD6), Chr(&HC2))
　　
　　'濁音、半濁音も共に静音に直す場合
'　　vntFind = Array(Chr(&HDE), Chr(&HDF), Chr(&HA7), Chr(&HA8), _
　　　　　　　　　　Chr(&HA9), Chr(&HAA), Chr(&HAB), Chr(&HAC), _
　　　　　　　　　　Chr(&HAD), Chr(&HAE), Chr(&HAF))
'　　vntReplace = Array("", "", Chr(&HB1), Chr(&HB2), Chr(&HB3), _
　　　　　　　　　　　　Chr(&HB4), Chr(&HB5), Chr(&HD4), Chr(&HD5), _
　　　　　　　　　　　　Chr(&HD6), Chr(&HC2))
　　
　　If vntValue = "" Then
　　　　Exit Function
　　End If
　　
　　'半角カタカナに変換
　　vntValue = StrConv(vntValue, vbNarrow + vbKatakana)
　　'小さいカタカナを大きいカタカナに
　　For i = 0 To UBound(vntFind)
　　　　 vntValue = Replace(vntValue, vntFind(i), vntReplace(i))
　　Next i
　　
　　KanaConv = vntValue

End Function

2 hits

▼

【49646】半角カナでも小さいカナを大きいカナに一括変換したい 柏餅 07/6/14(木) 17:11