Attribute VB_Name = "Module1"
'■　マクロ５００連発＜第２段＞
'
'　半角カタカナを判別する
'
'  Copyright(C) 2000 Sunago
'
Option Explicit

Sub Macro1()
Dim aryHantei(3) As String
Dim aryKekka(3) As Boolean
Dim i As Integer
Dim sOutput As String

    '判定文字列を作成する
    aryHantei(0) = "ｱｲｳｴｵ"
    aryHantei(1) = "アイウオエ"
    aryHantei(2) = "あいうえお"
    aryHantei(3) = "ｱｲウエオ"
    'カタカナ判定関数を呼び出す
    For i = 0 To UBound(aryHantei)
        aryKekka(i) = IsKatakana(aryHantei(i))
        sOutput = sOutput & aryHantei(i) & "　" & _
                IIf(aryKekka(i), "True", "False") & vbCr
    Next
    '結果を表示する
    MsgBox sOutput
    
End Sub

'/* カタカナ判定関数(IsKatakana) */
'
'　arg1 := 判定対象文字列
'  compare := 判定条件（規定値は半角カナ判定）

Public Function IsKatakana(arg1 As String, Optional compare As String = "Narrow") As Boolean
Dim strText As String
Dim strChar As String
Dim i As Long

    strText = StrConv(arg1, vbWide)
    If compare = "Narrow" Then
        If arg1 <> StrConv(arg1, vbNarrow) Then
            IsKatakana = False
        Else
            IsKatakana = True
            For i = 1 To Len(strText)
                strChar = Mid(strText, i, 1)
                If AscW(strChar) < 12450 Or AscW(strChar) > 12534 Then
                    IsKatakana = False
                    Exit For
                End If
            Next
        End If
    Else
        IsKatakana = True
        For i = 1 To Len(strText)
            strChar = Mid(strText, i, 1)
            If AscW(strChar) < 12450 Or AscW(strChar) > 12534 Then
                IsKatakana = False
                Exit For
            End If
        Next
    End If
    
End Function