16.43.EXCELマクロの登録方法

Sub SetCell()
   
   Dim AA As Integer
   Dim DBCSSV As Integer
   Dim CC As Integer
   Dim RR As Integer
   Dim i As Integer
   Dim SBCS As Integer
   Dim DBCS As Integer
   Dim ADD As Integer
   Dim VL As Variant
   Dim Char As Variant
   
   VL = ActiveCell.Value
   CC = ActiveCell.Column
   RR = ActiveCell.Row
    
   For i = 1 To Len(VL) Step 1
         
         Char = UCase(Mid(VL, i, 1))
                  
         AA = Asc(Char)
         
         If (0 < AA And AA < 255) Then
            SBCS = 1
         Else
            SBCS = 0
         End If
         
         '0e 漢字の開始
         If (SBCS = 0 And DBCSSV = 0) Then
            Cells(RR, CC) = "@"
            'Cells(RR, CC).Font.ColorIndex = 8
            CC = CC + 1
         End If
         
         '0f　漢字の終了
         If (SBCS = 1 And DBCSSV = 1) Then
            Cells(RR, CC) = "@"
            'Cells(RR, CC).Font.ColorIndex = 8
            CC = CC + 1
         End If
         
         If SBCS = 0 Then
            DBCSSV = 1
         Else
            DBCSSV = 0
         End If
         
         Cells(RR, CC) = Char
         
         If SBCS = 1 Then
            ADD = 1
         Else
            ADD = 2
         End If
         
         CC = CC + ADD
   Next
    
         If (SBCS = 0 And DBCSSV >= 1) Then
            Cells(RR, CC) = "@"
            'Cells(RR, CC).Font.ColorIndex = 8
         End If

End Sub