ちょっと便利なユーザー関数集(その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

 参考までに
定数 コード キー名 定数 コード キー名
vbKeyLButton 1 マウスの左ボタン vbKeySpace 32 Space キー
vbKeyRButton 2 マウスの右ボタン vbKeyPageUp 33 PageUp キー
vbKeyCancel 3 Cancel キー vbKeyPageDown 34 PageDown キー
vbKeyMButton 4 マウスの右ボタン vbKeyEnd 35 End キー
vbKeyBack 8 BackSpace キー vbKeyHome 36 Home キー
vbKeyTab 9 Tab キー vbKeyLeft 37 ← キー
VbLf 10 ラインフィード文字 vbKeyUp 38 ↑ キー
VbCrLf 改行して次の行の先頭に移動 vbKeyRight 39 → キー
vbKeyClear 12 Clear キー vbKeyDown 40 ↓ キー
vbKeyReturn 13 Enter キー vbKeySelect 41 Select キー
vbKeyShift 16 Shift キー vbKeyPrint 42 PrintScreen キー
vbKeyControl 17 Ctrl キー vbKeyExecute 43 Execute キー
vbKeyMenu 18 Alt キー vbKeySnapshot 44 Snapshot キー
vbKeyPause 19 Pause キー vbKeyInsert 45 Ins キー
vbKeyCapital 20 CapsLock キー vbKeyDelete 46 Del キー
vbKeyEscape 27 Esc キー vbKeyHelp 47 Help キー

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