| |
セルポインタの有る列で、セルポインッタ以下を変換します
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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
