Excel VBA質問箱 IV

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

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


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

56152 / 76732

←次へ　｜　前へ→


	【25340】Re:文字の置き換え

Hirofumi - 05/5/29(日) 1:18 -


	引用なし

	パスワード

面白そうだから作って見たけど
何万行のオーダーだといくら時間が掛かるか？

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

1 hits

▼

【25322】文字の置き換え hiroshi 05/5/28(土) 15:01