ちょっと便利なユーザー関数集(その1) |
********** 目 次 ********** 1.ANSI(旧Basic・シフトJIS)流文字列長を得る 2.データ交換する(スワップ Swap関数) 3.Locate 関数を使う 4.半角・全角文字の判定をする 5.数字しか入力できないように制限する 6.四捨五入の関数(四捨五入・切上・切り捨て・桁数を指定) 7.小数点以下の数値が含む計算上の注意事項 8. 9.ユーザー関数集(その2)へ移動 |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
1.ANSI(旧Basic・シフトJIS)流文字列長を得る | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Function LenA(mozi As String) As Integer LenA = LenB(StrConv(mozi, vbFromUnicode)) End Function このような関数を標準モジュールに作っておけば mozi = LenA("AB琵琶湖") ’mozi=8 で使えるようになり便利である。 全角=2バイト 半角=1バイト で計算する |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
2.データ交換する(スワップ Swap関数) | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Sub Swap(Deta1, Deta2) Dim Sw If VarType(Deta1) <> VarType(Deta2) Then Exit Sub Sw = Deta1: Deta1 = Deta2: Deta2 = Sw End Sub 使い方はいたって簡単 a = "aa": b = "bb" Swap a, b これで変数 a,b の内容が入れ替わる。ただし、異なる変数型間の交換はできない。 又、大量のデータ(1万件以上位)をソートする場合は速度等の関係であまりお薦めできません。 |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
3.Locate 関数を使う (088) | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Sub Locate(X As Variant, Y As Variant) ScaleMode = 4 CurrentX = X: CurrentY = Y End Sub 使い方 Locate 30, 5: Print "30桁目の5行目に表示" これで 旧 Basic のLocate関数が使える。 尚、印刷位置指定にも使えます。 又は、少し改造すると色々な物に使用できます。 Private Sub Locate(myObj As Object, X As Long, Y As Long, myStr As String) With myObj .ScaleMode = vbCharacters 'キャラクターモード .CurrentX = X .CurrentY = Y End With myObj.Print myStr End Sub 使用例 3行目の4桁目に表示 Locate Picture1, 4, 3, "花ちゃんのホームページ" |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
4.半角・全角文字の判定をする (086) | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
まず、下記コードを試して下さい。 Option Explicit 'SampleNo=086 WindowsXP VB6.0(SP5) 2002.05.17 Private Sub Text1_KeyPress(KeyAscii As Integer)
Debug.Print KeyAscii If KeyAscii = vbKeyReturn Then KeyAscii = 0 Else If KeyAscii >= 0 And KeyAscii < 31 Then MsgBox "制御文字です" Exit Sub End If If KeyAscii > 0 And KeyAscii < 255 Then MsgBox "Ascii コード 255 以内です" '128 〜 160 と 224 〜 255 はキーボードから直接入力不可 End If If KeyAscii > 160 And KeyAscii < 224 Then MsgBox "半角カナ文字です" End If If LenB(StrConv(Chr$(KeyAscii), vbFromUnicode)) = 1 Then MsgBox "シフトJISコード 1バイト文字です" End If End If End Sub イミディエイトウィンドウで ?chr(64) と入力すると @ が表示します イミディエイトウィンドウで ?asc("@") と入力すると 64 が表示します ヘルプで ASCII 文字セット (0 - 127) ASC 関数 32 ビット版での文字列操作の注意事項 等も調べて下さい それを関数化すると Private Function fHanOrZen(myString As String) As Integer If Len(myString) = 1 Then 'エラー処理 0 を返す If Asc(myString) >= 0 And Asc(myString) <= 255 Then fHanOrZen = 1 '半角=1 Else fHanOrZen = 2 '全角=2 End If Else fHanOrZen = 0 '指定不良=0 End If End Function 使用方法 Private Sub Command1_Click()
Dim Ret As Integer Ret = fHanOrZen(Text2.Text) Select Case Ret Case 1 MsgBox "半角文字です" Case 2 MsgBox "全角文字です" Case 0 MsgBox "指定方法が間違ってます" End Select End Sub 参考までに
|
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
5.数字しか入力できないように制限する(簡易型) (069) | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Private Sub Text1_KeyPress(KeyAscii As Integer) '数値しか入力できないように制限する(簡易型) If KeyAscii >= 32 And KeyAscii < 45 Or _ KeyAscii > 57 Or KeyAscii = 47 Then Beep 'エラー音 KeyAscii = 0 '入力キーを無効にする End If End Sub KeyAscii >= 32 は[Enter]キーや[BackSpace]キーを使えるようにしている。 又、マイナスキーやコンマが入力できます。 ASCIIコード表は、ヘルプで「ASCII 文字セット」を検索して下さい APIを使ったやり方もありますが上記同様、貼付られたら文字も入力できてしまいます。 そこで、それらを解決したのが下記改良型です。 関数化した改良型のサンプル |
|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
6.四捨五入の関数(四捨五入・切上・切り捨て・桁数を指定) (064) | |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
四捨五入だけでその都度書くなら Private Sub Command2_Click() Dim A As Single Text1.Text = "5.555" Text2.Text = Format$(Text1.Text, "###.#") '結果 5.6 End Sub WindowsXPの場合Format関数を使用すると五捨五入になるので注意(下記参照) Windows XP に含まれているオートメーションライブラリ 3.50 環境では、 Format 関数は、丸めの対象となる数値が 5 の 場合、最も一般的である 「丸めの対象とな る一桁前の数値が偶数であれば繰り下げ、奇数であれば 繰り上げる」 という方法で数値の丸めの処理を行います。 Windows XP 環境において Format 関数は以下のように動作します。 例: Format("0.5", "#,##0") '0 が返ります Format("1.5", "#,##0") '2 が返ります Format("2.5", "#,##0") '2 が返ります Format("3.5", "#,##0") '4 が返ります 自分で四捨五入の関数を作るなら Option Explicit 'SampleNo=064 WindowsXP VB6.0(SP5) 2002.05.15 '======================================================= '四捨五入・切り捨て・切り上げ処理関数 '======================================================= '使用方法 result=fRound(MyVal,Keta, UpDo) '−−−−−−−−−−−−−−−−−−−−−−−−−−−−− '引数 MyVal :対象となる数値(Currencyの範囲)(""不可) ' Keta :処理をする桁数(省略時:0桁) ' UpDo :処理方法(省略時=0:四捨五入)1=切上 その他=切捨 '戻値 result:処理結果(Currency型) '------------------------------------------------------- Private Function fRound(ByVal MyVal As Currency, Optional ByVal keta _ As Integer = 0, Optional ByVal UpDo As Integer = 0) As Currency '指定桁数の制限 If keta < 0 Or keta > 3 Or Len(Str$(MyVal)) > 17 Then MsgBox "正しい桁数の範囲で設定して下さい", vbOKOnly, "桁エラー" Exit Function End If If keta Then '小数点第二位以上の場合の処理 MyVal = MyVal * (10 ^ keta) End If Select Case UpDo Case 0 '四捨五入 If MyVal < 0 Then MyVal = MyVal - 0.5 Else MyVal = MyVal + 0.5 End If Case 1 '切り上げ If MyVal - CInt(MyVal) Then If MyVal < 0 Then MyVal = MyVal - 1 Else MyVal = MyVal + 1 End If End If Case Else End Select 'その他は切り捨て処理 MyVal = Fix(MyVal) If keta Then '元の桁に戻す MyVal = MyVal / (10 ^ keta) End If fRound = MyVal End Function Private Sub Command1_Click() Dim UpDo As Integer If Option1(0).Value = True Then UpDo = 0 ElseIf Option1(1).Value = True Then UpDo = 1 Else UpDo = 2 End If Text2.Text = fRound(CCur(Text1.Text), CInt(Text3.Text), UpDo) End Sub 顧客によって、消費税の算出方法が違う場合、こんな関数があれば便利ですよネ!。 注意 上記では、消費税計算用に Currency 型を使っておりますので小数部桁数を制限しております、。 小数点以下の数値が含む計算上の注意事項 パソコンは2進数で電卓は10進数で計算するために、どうしても小数点以下の計算で誤差が発生します。 電卓では100÷3×3=99.9999999 PCでは100÷3×3=100 になります 次の例では Ans=18.45 のはずが 18.449 となる Private Sub Command2_Click() Dim dblValue1 As Double Dim dblValue2 As Double Dim dblValue3 As Double Dim curValue1 As Currency Dim curValue2 As Currency Dim curValue3 As Currency dblValue1 = 123 curValue1 = 123 dblValue2 = 0.15 curValue2 = 0.15 dblValue3 = Fix((dblValue1 * dblValue2) * 1000) / 1000 curValue3 = Fix((curValue1 * curValue2) * 1000) / 1000 Label2.Caption = Format$(dblValue3, "#,###.####") '18.449 Label3.Caption = Format$(curValue3, "#,###.####") '18.45 End Sub こういった場合変数を Currency型 Variant型で計算して下さい |
2002/05/17