テキストボックスに数値と少数点のドットのみ入力できるようにする
UserForm1 に TextBox1 を貼り付け、貼り付けたコントロールに数字と小数点のドット（.）以外はキー入力できないようにします。
TextBox1のプロパティー
IMEMode を 3 - fmIMEModeDisable にセットします。
fmIMEMode の設定値は次のとおりです。
定数 値 説明
fmIMEModeNoControl 0 IME を制御しません (既定値)。
fmIMEModeOn 1 IME をオンにします。
fmIMEModeOff 2 IME はオフの状態です。 英語モード。
fmIMEModeDisable 3 IME をオフにします。 ユーザーはキーボードで IME をオンにできません。
fmIMEModeHiragana 4 全角ひらがなモードで IME をオンにします。
fmIMEModeKatakana 5 全角カタカナ モードで IME をオンにします。
fmIMEModeKatakanaHalf 6 半角カタカナ モードで IME をオンにします。
fmIMEModeAlphaFull 7 全角英数字モードで IME をオンにします。
fmIMEModeAlpha 8 半角英数字モードで IME をオンにします。
'----------------------------------------------------------------------
Private Sub TextBox1_Change()
Dim Txtbuf As String
Dim buf(1) As String
Dim val As Variant
Txtbuf = Me.TextBox1.Value
If Len(Txtbuf) = 0 Then
'テキストボックスに値がない場合
buf(0) = 0
buf(1) = ""
Else
'テキストボックスに値がある場合
If Not IsNumeric(Txtbuf) Then
'数値でない場合
buf(0) = ""
buf(1) = ""
Else
'数値の場合、整数部分と少数部分に分離します
val = Split(Txtbuf, ".")
'整数部分を格納します
buf(0) = val(0)
If UBound(val) = 0 Then
'少数点がない場合
buf(1) = ""
Else
'少数点がある場合、ドットを付けて格納します
buf(1) = "." & val(1)
End If
End If
End If
'整数部分を位どりして繋げます
Me.TextBox1.Value = Format(buf(0), "#,##0") & buf(1)
End Sub
'----------------------------------------------------------------------
Private Sub TextBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
If (KeyAscii < Asc("0") Or KeyAscii > Asc("9")) Then
If KeyAscii = Asc(".") Then
If Len(Me.TextBox1) > 0 Then
If InStr(Me.TextBox1.Value, ".") > 0 Then
'2つ目の小数点の場合、無効化
KeyAscii = 0
Else
'初めての小数点の場合、制限しません
End If
Else
'初めの入力でドット（.）を入力した場合、無効化
KeyAscii = 0
'その代わりにボックスに「0.」をセットする
Me.TextBox1.Value = "0."
End If
Else
'0～9でなく、かつドットでない場合、無効化
KeyAscii = 0
End If
Else
'0～9までの数値の場合、制限しません
End If
End Sub
シートの列行に名前を付け名前と列・列番号のハッシュテーブル
'----------------------------------------------------------------------
Public ShRowCol As Dictionary
'----------------------------------------------------------------------
Public Sub ShRowColMake()
Dim KRow As Long
Dim KCol As Long
Dim Sh As Worksheet
Dim EndNum As Long
Dim I As Long
Dim Dic As Dictionary
Dim cDic As Dictionary
Dim Buf As String
Set ShRowCol = New Dictionary
For Each Sh In Worksheets
KRow = 0
KCol = 0
'探査とすべき行番号、列番号を取得します。
Call PosiRowCol(Sh, KRow, KCol)
Set Dic = New Dictionary
If KCol > 0 Then
With Sh
'行方向を探査します。
EndNum = .Cells(.Rows.Count, KCol).End(xlUp).Row
Set cDic = New Dictionary
For I = KRow To EndNum
'行名を取得
Buf = .Cells(I, KCol).Value
If Buf <> "" Then
'空でないこと
With cDic
If Not .Exists(Buf) Then
'未登録なら
'行名と行番号を登録します。
.Add Buf, I
End If
End With
End If
Next I
'キー行で登録します。
With Dic
.Add "行", cDic
End With
Set cDic = Nothing
'列方向を探査します。
EndNum = .Cells(KRow, .Columns.Count).End(xlToLeft).Column
Set cDic = New Dictionary
For I = KCol To EndNum
'列名を取得
Buf = .Cells(KRow, I).Value
If Buf <> "" Then
'空でないこと
With cDic
If Not .Exists(Buf) Then
'未登録なら
'列名と列番号を登録します。
.Add Buf, I
End If
End With
End If
Next I
'キー列で登録します。
With Dic
.Add "列", cDic
End With
Set cDic = Nothing
End With
End If
'キーシート名で登録します。
With ShRowCol
.Add Sh.Name, Dic
End With
Set Dic = Nothing
Next Sh
End Sub
'----------------------------------------------------------------------
Public Sub PosiRowCol(ByRef Sh As Worksheet, _
ByRef KRow As Long, _
ByRef KCol As Long)
Dim Data As Variant
Dim baseRow As Long
Dim baseCol As Long
Dim I As Long
Dim J As Long
With Sh
If .UsedRange Is Nothing Then
Exit Sub
End If
'使われている領域の配列を取得します。
Data = .UsedRange.Value
'行・列番号を補正するため、UsedRange のトップセルの位置を取得
With .UsedRange.Cells(1,1)
baseRow = .Row
baseCol = .Column
End With
End With
'行列名を探します。
For I = 1 To UBound(Data, 1)
For J = 1 To UBound(Data, 2)
If Data(I, J) = "行列名" Then
'行番号、列番号を取得します。
KRow = I + (baseRow - 1)
KCol = J + (baseCol - 1)
'I,J ループを抜けます。
I = UBound(Data, 1)
J = UBound(Data, 2)
End If
Next J
Next I
End Sub