VBAを使用していくつかのタイトルを読み、その情報をPowerPointプレゼンテーションにコピーしています。
私の問題は、タイトルに特殊文字が含まれているが、私が対処している画像ファイルには特殊文字がないことです。
TITLEは、JPEGを画像コンテナーにロードするパスの一部を形成します。例えば。 「P k.jpg」ですが、タイトルは「p.k」と呼ばれます。
TITLEの特殊文字を無視して、代わりにスペースを表示して適切なJPGファイルを取得できるようにしたいのです。
それは可能ですか?
ありがとうございました!
「特殊な」文字、単なる句読点とは何ですか? Replace
関数を使用できるはずです:Replace("p.k","."," ")
。
Sub Test()
Dim myString as String
Dim newString as String
myString = "p.k"
newString = replace(myString, ".", " ")
MsgBox newString
End Sub
複数の文字がある場合、カスタム関数または単純な一連のReplace
関数などでこれを実行できます。
Sub Test()
Dim myString as String
Dim newString as String
myString = "!p.k"
newString = Replace(Replace(myString, ".", " "), "!", " ")
'## OR, if it is easier for you to interpret, you can do two sequential statements:
'newString = replace(myString, ".", " ")
'newString = replace(newString, "!", " ")
MsgBox newString
End Sub
潜在的な特殊文字(英語以外のアクセント付きASCIIなど)が多数ある場合、カスタム関数または配列の反復を実行できます。
Const SpecialCharacters As String = "!,@,#,$,%,^,&,*,(,),{,[,],},?" 'modify as needed
Sub test()
Dim myString as String
Dim newString as String
Dim char as Variant
myString = "!p#*@)k{kdfhouef3829J"
newString = myString
For each char in Split(SpecialCharacters, ",")
newString = Replace(newString, char, " ")
Next
End Sub
特殊文字のリストを除外するだけでなく、文字でも数字でもないall文字を除外する場合は、 char型の比較アプローチを使用します。
文字列の各文字について、Unicode文字が「A」と「Z」の間、「a」と「z」の間、または「0」と「9」の間にあるかどうかを確認します。これはvbaコードです:
Function cleanString(text As String) As String
Dim output As String
Dim c 'since char type does not exist in vba, we have to use variant type.
For i = 1 To Len(text)
c = Mid(text, i, 1) 'Select the character at the i position
If (c >= "a" And c <= "z") Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Then
output = output & c 'add the character to your output.
Else
output = output & " " 'add the replacement character (space) to your output
End If
Next
cleanString = output
End Function
nicode文字のウィキペディアリスト は、この機能をもう少しカスタマイズする場合のクイックスタートとして適しています。
このソリューションには、ユーザーが新しい特殊文字を導入する方法を見つけた場合でも機能するという利点があります。また、2つのリストを一緒に比較するよりも高速です。
特殊文字を削除する方法は次のとおりです。
私は単に正規表現を適用しました
Dim strPattern As String: strPattern = "[^a-zA-Z0-9]" 'The regex pattern to find special characters
Dim strReplace As String: strReplace = "" 'The replacement for the special characters
Set regEx = CreateObject("vbscript.regexp") 'Initialize the regex object
Dim GCID As String: GCID = "Text #N/A" 'The text to be stripped of special characters
' Configure the regex object
With regEx
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = strPattern
End With
' Perform the regex replacement
GCID = regEx.Replace(GCID, strReplace)
これに基づいてこれが私が使用するものです link
Function StripAccentb(RA As Range)
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Dim S As String
'Const AccChars = "ŠŽšžŸÀÁÂÃÄÅÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖÙÚÛÜÝàáâãäåçèéêëìíîïðñòóôõöùúûüýÿ"
'Const RegChars = "SZszYAAAAAACEEEEIIIIDNOOOOOUUUUYaaaaaaceeeeiiiidnooooouuuuyy"
Const AccChars = "ñéúãíçóêôöá" ' using less characters is faster
Const RegChars = "neuaicoeooa"
S = RA.Cells.Text
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
S = Replace(S, A, B)
'Debug.Print (S)
Next
StripAccentb = S
Exit Function
End Function
使用法:
=StripAccentb(B2) ' cell address
シート内のすべてのセルのサブバージョン:
Sub replacesub()
Dim A As String * 1
Dim B As String * 1
Dim i As Integer
Dim S As String
Const AccChars = "ñéúãíçóêôöá" ' using less characters is faster
Const RegChars = "neuaicoeooa"
Range("A1").Resize(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column).Select '
For Each cell In Selection
If cell <> "" Then
S = cell.Text
For i = 1 To Len(AccChars)
A = Mid(AccChars, i, 1)
B = Mid(RegChars, i, 1)
S = replace(S, A, B)
Next
cell.Value = S
Debug.Print "celltext "; (cell.Text)
End If
Next cell
End Sub