|
面白そうだから作って見たけど
何万行のオーダーだといくら時間が掛かるか?
Option Explicit
Public Sub Test2()
'11大阪府11
MsgBox "11大阪府11 → " & GetPurpose("11大阪府11")
'11大阪府
MsgBox "11大阪府 → " & GetPurpose("11大阪府")
'11大阪府-11
MsgBox "11大阪府-11 → " & GetPurpose("11大阪府-11")
End Sub
Public Function GetPurpose(ByVal strMark As String) As String
Dim i As Long
Dim lngIndex As Long
Dim bytResult() As Byte
Dim strLetter As String
Dim bytLetter() As Byte
Dim blnWide As Boolean
Dim strReplace As String
Dim bytReplace() As Byte
If strMark = "" Then
Exit Function
End If
strMark = StrConv(strMark, vbNarrow)
strReplace = StrConv("-", vbFromUnicode)
bytReplace = strReplace
For i = 1 To Len(strMark)
strLetter = StrConv(Mid(strMark, i, 1), vbFromUnicode)
If LenB(strLetter) <> 2 Then
If strLetter <> strReplace Then
blnWide = False
bytLetter = strLetter
ReDim Preserve bytResult(lngIndex)
bytResult(lngIndex) = bytLetter(0)
lngIndex = lngIndex + 1
End If
Else
If Not blnWide Then
blnWide = True
ReDim Preserve bytResult(lngIndex)
bytResult(lngIndex) = bytReplace(0)
lngIndex = lngIndex + 1
End If
End If
Next i
If blnWide Then
ReDim Preserve bytResult(lngIndex - 2)
End If
GetPurpose = StrConv(CStr(bytResult), vbUnicode)
End Function
|
|