Sub ki148()

   dat = Cells(11, 4)
   ja = 1: jb = 0: daa = ""
   Do
   da1 = InStr(ja, dat, " ")
   If da1 > 0 Then
        data = Mid(dat, da1 - 1, 1)
        If Hex(Asc(data)) > "8100" Then
            jb = 1
            daa = Left(dat, da1 - 1)
            dab = Mid(dat, da1 + 1)
            dat = daa & dab
            ja = da1
        Else
            ja = da1 + 1
        End If
    Else
        If jb = 1 Then
            Exit Do
        End If
    End If
  Loop Until da1 = 0
  
    Cells(13, 4) = dat
    Cells(13, 4).Font.Size = 12
End Sub

Sub ki148a()
Cells(11, 4) = "Aaaaa Bbbbbb ア ルミCcccc Ddddカ セット eeムー ンＲ"
Range("D11").Font.Size = 12
Range("D13").ClearContents
Range("B11").Select
End Sub