エクセルのセルに入力された値がUnicodeで****から****までの範囲内のみの文字で記述されているかのチェックをしたいのですが、
例:B3には電話番号を入力したいので半角数字と()のみで構成されているかをチェックする。

VBAでどのように記述すればよいのでしょうか?

もう一つ、
セルB3に文字を入力し終えた時または、B3にあるカーソルを他のセルに動かした時に
VBAが走る…と言う記述方法はあるのでしょうか?

ボタンを用意し、入力後[CHECK]を押すとVBAが動くと言うのは出来るのですが…

以上よろしくお願いいたします。

このQ&Aに関連する最新のQ&A

A 回答 (1件)

B3に変更があったら入力された値を調べています。

Worksheet_Changeを使っています。
B3があるシートのコードウインドウに貼り付けます。

ご参考に。

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
  Dim dt As String  '入力データ
  Dim p As Integer  '文字の位置カウンタ

  '変更セルが単一の場合
  If Target.Count = 1 Then
    '変更セルがB3の場合
    If Target.Address = "$B$3" Then
      dt = Target.Text  'B3に入力した値
      '文字を調べる
      For p = 1 To Len(dt)
        If InStr("1234567890()", Mid(dt, p, 1)) = 0 Then
          '指定文字以外があったらメッセージを出す例
          MsgBox "不正な文字『 " & Mid(dt, p, 1) & " 』があります。"
          Exit For
        End If
      Next
    End If
  End If
End Sub
    • good
    • 0
この回答へのお礼

ありがとうございます。助かりました。

お礼日時:2002/02/20 18:50

このQ&Aに関連する人気のQ&A

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aと関連する良く見られている質問

QセルA2に探したい文字列を入力し、B15:B376に入力されている文字を検索する

タイトル通りなのですが、可能でしょうか?
よろしくお願いします

Aベストアンサー

こんにちは!

VBAでの一例です。
そのセルへ飛ぶようにしてみました。

画面左下の操作したいシート見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)
A2セルにデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から//
Dim c As Range
With Target
If .Address = "$A$2" And .Count = 1 Then
If .Value <> "" Then
Set c = Range("B15:B376").Find(what:=.Value, LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Select
Else
MsgBox "該当データなし"
.Select
End If
End If
End If
End With
End Sub 'この行まで//

※ 完全一致を前提としています。m(_ _)m

こんにちは!

VBAでの一例です。
そのセルへ飛ぶようにしてみました。

画面左下の操作したいシート見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)
A2セルにデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) 'この行から//
Dim c As Range
With Target
If .Address = "$A$2" And .Count = 1 Then
If .Value <> "" Then
...続きを読む

QExcelのVBAで、特定のセルを入力しないとファイルを保存できない設定で、その上書日時を別のセルに入力(但し条件有)

知恵袋にも質問しましたが、明日朝までに回答を頂けるか不安で、こちらにも質問します。

ExcelのVBAで、特定のセル(A1,B5,C10等)を入力しないとファイルを保存できない設定で、
(1)全て入力してたら、閉じる時に普段どおり、『「保存しますか?」の質問に「はい」「いいえ」「キャンセル」』のメッセージボックスが出るように
(2)入力してなかったら、閉じる時に『「未入力ですので、保存できません」』の質問に「保存しません」「キャンセル」』のメッセージボックスが出るように。
(3)また、作成者がそこを空白のまま保存できないので、作成者については、その制限がかからない方法
を下記のコードで教えていただきました。
その下記のコードに(4)上書可能で、上書きする時に特定のセル(D12)にその時の日を入力したいのですが、その日には条件があって、16:00より前ならその日、16:00以降なら翌日に入力されるように下記に付け加えたいのですが、どうすれば良いのでしょうか?

ブックモジュール[ThisWokbook]に
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Application.UserName = ThisWorkbook.BuiltinDocumentProperties("Author") Then Exit Sub '許可するユーザー名
Dim myRng As Range
Dim myStr As String
With Worksheets("Sheet1")
Set myRng = Union(.Range("A1"), .Range("B5"), .Range("C10"))
End With
If WorksheetFunction.CountA(myRng) < 3 Then
Cancel = True
myStr = "未入力セルがあります" & vbCrLf & _
"[OK....保存しないで終了]" & vbCrLf & _
"[キャンセル..編集に戻る]"
If MsgBox(myStr, vbOKCancel) = vbOK Then
ThisWorkbook.Close False
End If
End If
End Sub

知恵袋にも質問しましたが、明日朝までに回答を頂けるか不安で、こちらにも質問します。

ExcelのVBAで、特定のセル(A1,B5,C10等)を入力しないとファイルを保存できない設定で、
(1)全て入力してたら、閉じる時に普段どおり、『「保存しますか?」の質問に「はい」「いいえ」「キャンセル」』のメッセージボックスが出るように
(2)入力してなかったら、閉じる時に『「未入力ですので、保存できません」』の質問に「保存しません」「キャンセル」』のメッセージボックスが出るように。
(3)また、作成者がそ...続きを読む

Aベストアンサー

With Range("D12")
.Value = IIf(Format(Now, "hh:mm") <= "16:00", Date, Date + 1)
End With

ご参考程度に。

Q検索の実行で、ヒットした行のA列の番号を、セルB3に自動入力するマクロ

検索の実行で、ヒットした行のA列の番号を、セルB3に自動入力するマクロを教えてください。
エクセルの6行目から約19000行目まで、A列には1からの番号、B列に薬名、C列に剤形、D列にコードが入力されている薬台帳があるのですが、この台帳から薬名を検索して、最初にヒットしたA列の番号をセルB3に表示したいのです。
どなたかよろしくお願いします。

Aベストアンサー

>標準モジュールに貼り付けたのですが、動いてくれません。

動作しないのは、まるまる提示のコードを実行しようとしているか、あなたの質問に不備があるか、です。
当然のことながら、「What:="薬名"」の"薬名"の部分は検索したい薬名に正確に修正しないとダメです。
それでも動作しないなら、質問に記載されていない事項があるためです。

たとえば、新規ブックに、A6:A10に1から順に番号を振り、B10にでも「薬名」と入れて、提示したコードを貼り付け実行すれば、B3に5と表示されます。やりたいことと違う場合は再度質問を読み直されることをお勧めします。

Q文字を入力したセル以降のセルも同じ文字になるVBA

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
ActiveSheet.Protect UserInterfaceOnly:=True
Set R = Union(Range("D5:D38"), Range("E5:E38"), Range("T5:T38"))
With Target
If Intersect(.Cells, R) Is Nothing Then Exit Sub

Application.EnableEvents = False

Range(Cells(.Row, .Column), Cells(38, .Column)).Value = .Value

Application.EnableEvents = True

End With

End Sub

この様なコードがあるのですが範囲を変更したいと思います。

D5:D38は上記コードのままで良いのですが、E5;E38はE5:E36に、T5:T38はT5:T36に変更するにはどうすれば良いのでしょうか?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
ActiveSheet.Protect UserInterfaceOnly:=True
Set R = Union(Range("D5:D38"), Range("E5:E38"), Range("T5:T38"))
With Target
If Intersect(.Cells, R) Is Nothing Then Exit Sub

Application.EnableEvents = False

Range(Cells(.Row, .Column), Cells(38, .Column)).Value = .Value

Application.EnableEvents = True

End With

End Sub

この様なコードがあるのですが範囲を変更したいと思います。

D5:D38は上記コードの...続きを読む

Aベストアンサー

以下でどうでしょうか?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Dim A As Range
Dim I As Integer
ActiveSheet.Protect UserInterfaceOnly:=True
Set R = Union(Range("D5:D38"), Range("E5:E36"), Range("T5:T36"))
With Target
If Intersect(.Cells, R) Is Nothing Then Exit Sub
For I = 1 To R.Areas.Count
If Not Intersect(R.Areas(I), Target) Is Nothing Then
Set A = R.Areas(I)
Exit For
End If
Next I
Application.EnableEvents = False
Range(Cells(.Row, .Column), Cells(A.Cells(A.Rows.Count, 1).Row, .Column)).Value = .Value
Application.EnableEvents = True
End With
End Sub

以下でどうでしょうか?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range
Dim A As Range
Dim I As Integer
ActiveSheet.Protect UserInterfaceOnly:=True
Set R = Union(Range("D5:D38"), Range("E5:E36"), Range("T5:T36"))
With Target
If Intersect(.Cells, R) Is Nothing Then Exit Sub
For I = 1 To R.Areas.Count
If Not Intersect(R.Areas(I), Target) Is Nothing Then
Set A = R.Areas(I)
Exit Fo...続きを読む

Q入力セルが空白の時 隣りと隣のセル(こちらも入力セル)を空白にできるかどうか?

こういったことできないでしょうか。

 A1  B2  C3
9:00  ~  10:00 と場合に

A1とC3に直接値を入力しています。

A1セルに値がはいらないとき B2のチルダも C3の値も 空白になってくれると
よいなと思うのですが 良い方法はありますでしょうか。

ご存知の方ご教示いただければ助かります。

Aベストアンサー

こんばんは!

>C3のセルのことを B2に入力した式で
>管理できないかと思っているのですが・・・

関数では無理だと思います。
VBAになりますが一例です。

画面左下の操作したいシート見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)
A1・C3セルにデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) '//この行から//
If Intersect(Target, Range("A1,C3")) Is Nothing Then Exit Sub
If Target.Count = 1 Then
With Target
If .Row = 1 Then
If .Value <> "" Then
If Range("C3") <> "" Then
Range("B2") = "~"
End If
Else
Range("B2,C3").ClearContents
End If
Else
If .Value <> "" Then
Range("B2") = "~"
Else
Range("B2").ClearContents
End If
End If
End With
End If
End Sub '//この行まで//

※ A1セルがC3セルより大きな値になった場合などの細かいエラー処理はしていません。

こんな感じをお望みなのでしょうか?m(_ _)m

こんばんは!

>C3のセルのことを B2に入力した式で
>管理できないかと思っているのですが・・・

関数では無理だと思います。
VBAになりますが一例です。

画面左下の操作したいシート見出し上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻り(VBE画面を閉じて)
A1・C3セルにデータを入力してみてください。

Private Sub Worksheet_Change(ByVal Target As Range) '//この行から//
If Intersect(Target, Range("A1,C3")) ...続きを読む


このカテゴリの人気Q&Aランキング

おすすめ情報