基本的に1セル、1人です。また日本語名、英語名(ローマ字)混在しています。
特に日本語名だけ反転、英語名だけ反転、両方反転する方法をお願いします。
空白セルを考慮していませんでした。
姓名反転()内のFor Each以降の行を下記のように変更して下さい。
「If name <> "" Then」「End If」で空白セルを飛ばして処理します。
For Each name In Selection
If name <> "" Then
If flg = 0 Then
反転 name
Else
result = アルファベットチェック(name.Value)
If flg = 2 And result = True Then
反転 name
ElseIf flg = 1 And result = False Then
反転 name
End If
End If
End If
Next
関数でもいいでしょうか?
A1にデータがあるとして
全部変えるときは
B1に
=MID(A1,FIND(", ",A1)+2,100)&", "&LEFT(A1,FIND(", ",A1)-1)
英語だけ変えるときは
B1に
=IF((LEFT(A1,1)>="a")*AND(LEFT(A1,1)<="Z"),MID(A1,FIND(", ",A1)+2,100)&", "&LEFT(A1,FIND(", ",A1)-1),A1)
英語以外を変えるときは
=IF((LEFT(A1,1)>="a")*AND(LEFT(A1,1)<="Z"),A1,MID(A1,FIND(", ",A1)+2,100)&", "&LEFT(A1,FIND(", ",A1)-1))
ありがとうございます、参考になります。
両方か、日本語だけか、英語だけかによって、
flgの値を変えてください。
英語(ローマ字)かどうかの判定は先頭の文字がA-zで判定しています。
全角の英字が入力されている場合は、正しく判定できません。
Option Explicit
Sub 姓名反転()
Dim flg As Integer
Dim name As Range
Dim result As Boolean
flg = 0 '両方変換
' flg = 1 '日本語名だけ変換
' flg = 2 '英語名だけ変換
For Each name In Selection
If flg = 0 Then
反転 name
Else
result = アルファベットチェック(name.Value)
If flg = 2 And result = True Then
反転 name
ElseIf flg = 1 And result = False Then
反転 name
End If
End If
Next
End Sub
Sub 反転(data As Range)
Dim buf As Variant
Dim delimiter As String
delimiter = ", "
buf = Split(data, delimiter)
data.Value = buf(1) + delimiter + buf(0)
End Sub
Function アルファベットチェック(data As String) As Boolean
Dim topword As Integer
topword = Asc(Left(data, 1))
If topword >= Asc("A") And topword <= Asc("z") Then
アルファベットチェック = True
Else
アルファベットチェック = False
End If
End Function
ありがとうございます。ただ空白セルがあるとそれ以降がうまく反転しないので何とかなりませんか?
空白セルを考慮していませんでした。
姓名反転()内のFor Each以降の行を下記のように変更して下さい。
「If name <> "" Then」「End If」で空白セルを飛ばして処理します。
For Each name In Selection
If name <> "" Then
If flg = 0 Then
反転 name
Else
result = アルファベットチェック(name.Value)
If flg = 2 And result = True Then
反転 name
ElseIf flg = 1 And result = False Then
反転 name
End If
End If
End If
Next
ありがとうございます、希望通りの事が出来ました。
ありがとうございます、希望通りの事が出来ました。