Tagbangers Blog

VBAで入力チェック&書式制限して貼り付け

「エクセルで入力チェックってできない?」

「張り付ける時に書式を張り付けたくないんだけど、そういう制御ってできない?」

について緩く調査した結果をアウトプット


入力チェック

Private Sub Worksheet_Change(ByVal Target As Range)("/companies")


    Dim wCellVal As String

   

    'セルの値を取得する

    With Worksheets("Sheet1")

        wCellVal = .Cells(Target.Row, Target.Column).Value

    End With

     

    '文字数チェックをしたい場合は

    If Target.Column = 1 Then

        If Len(wCellVal) > 10 Then

            MsgBox "10桁以内で入力してください。", vbOKOnly + vbExclamation, "入力エラー"

            Exit Sub

        End If

    End If
     
    '半角チェックをしたい場合は

    If Target.Column = 2 Then

        If Len(wCellVal) <> LenB(StrConv(wCellVal, vbFromUnicode)) Then

            MsgBox "半角で入力してください。", vbOKOnly + vbExclamation, "入力エラー"

            Exit Sub

        End If

    End If

 
    '全角チェックをしたい場合

    If Target.Column = 3 Then

        If Len(wCellVal) * 2 <> LenB(StrConv(wCellVal, vbFromUnicode)) Then

            MsgBox "全角で入力してください。", vbOKOnly + vbExclamation, "入力エラー"

            Exit Sub

        End If

    End If
        

    '数字チェックをしたい場合

    If Target.Column = 4 Then

        If Not IsNumeric(wCellVal) Then

            MsgBox "単価は数字で入力してください。", vbOKOnly + vbExclamation, "入力エラー"

            Exit Sub

        End If

    End If

End Sub

エクセルのわかりづらいところではあるんですが冒頭の

    If Target.Column = 4 Then

数字部分が1ならA列、2ならB列といった具合に遷移していきます。


んで、貼り付けのフォーマットを指定するやりかた。結構無理やりなので、本当にやりたいことかどうかは調整が必要。

ファイルを開いた時に、選択させて、yesならコピーして貼り付けた時に、必ず値の貼り付けになるように制御。


Sub auto_open()     Dim Rtn As Integer     Rtn = MsgBox("ショートカットキーを「値のみ」にセットしますか?", vbYesNo)     If Rtn = vbYes Then         key     End If  End Sub  '------------------------  Sub key()     Application.OnKey "^{v}", "copy"  End Sub  '-------------------------  Sub copy()     ActiveCell.PasteSpecial Paste:=xlValues     Application.CutCopyMode = False  End Sub  '-------------------------  Sub end_key()     Application.OnKey "^{v}"  End Sub

改めてまだまだエクセルが使われている場面が多くあることを実感。

そして困っていることは結構みな同じ、というか近い部分があるのかなと。