Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2066 / 9994 ←次へ | 前へ→

【11208】四捨五入のPGをもう少し工夫したいのですが。
質問  tomomi  - 09/10/6(火) 9:40 -

引用なし
パスワード
   Option Compare Database
'ダイアログの変数を定義

Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "Comdlg32" Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long


'参照ボタンクリック時にファイルを開くダイアログを表示

Private Sub 参照_Click()

 Dim o As OPENFILENAME
  With o
   .lpstrFile = String(256, vbNullChar)

   .nMaxFile = LenB(o.lpstrFile)
   .lpstrFilter = "テキストファイル" & vbNullChar & "*.txt;*.csv"
   .lpstrInitialDir = "C:\AcpkDB"
   .lStructSize = LenB(o)
  End With
 GetOpenFileName o
 If o.lpstrFile = vbNullChar Then
  MsgBox "キャンセルされました"
  Me.テキスト0 = ""
  Exit Sub
 End If
  Me.テキスト0 = Left(o.lpstrFile, InStr(o.lpstrFile, vbNullChar) - 1)


'選択したテキストファイル内のデータをテキスト1に表示する。

Dim TargetFile As String, n As Long, buf As String
  n = FreeFile
  TargetFile = Me.テキスト0
  buf = Space(FileLen(TargetFile))
  Open TargetFile For Binary As #n
    Get #n, , buf
  Close #n
  Me.テキスト1 = buf
End Sub


'四捨五入ボタンを押したとき


Private Sub 四捨五入_Click()
Me.テキスト2 = TextConv(Me.テキスト1)

End Sub

Private Sub Form_Open(Cancel As Integer)
  'フォームを開いた時点で
  DoCmd.Restore
  Me.テキスト0 = ""
  Me.テキスト1 = ""
  Me.テキスト2 = ""
  
  
  'テキスト1,2は編集ロックをかける
  
  Me.テキスト1.Enabled = False
  Me.テキスト1.Locked = True
  
  Me.テキスト2.Enabled = False
  Me.テキスト2.Locked = True
  
End Sub

Private Sub クリア_Click()

'クリアボタンを押すことでテキスト0〜2の文字を全て消去する
  Me.テキスト0 = ""
  Me.テキスト1 = ""
  Me.テキスト2 = ""
  Me.参照.SetFocus
  
End Sub

Private Sub 終了_Click()
'終了ボタンを押すことで全てを終了する

  DoCmd.Quit
  
End Sub
'四捨五入

Function TextConv(文字列 As String) As String
 
 Const 数字データ = "0123456789.", 四捨五入 As Currency = 0.05
 Dim 数字列 As Integer, 変換数値 As String
 Dim Idx1 As Long, Idx2 As Long, 文字列数 As Long
 
 TextConv = 文字列
 文字列数 = Len(文字列) + 1
  
  For Idx1 = 1 To 文字列数
  
  If Idx1 <> 文字列数 And _
    InStr(1, 数字データ, Mid(文字列, Idx1, 1), vbBinaryCompare) > 0 Then
   数字列 = 数字列 + 1
   
  Else
  
   If 数字列 > 0 Then
    変換数値 = Mid(文字列, Idx1 - 数字列, 数字列)
    変換数値 = Format(Int((Val(変換数値) + 四捨五入) * 10) / 10, "0.00")
    
    If Len(変換数値) > 数字列 Then
     TextConv = Left(TextConv, Idx1 + Idx2 - 数字列 - 1) & NumStr & _
           Mid(文字列, Idx1)
     Idx2 = Idx2 + 1
    Else
    
     Mid(TextConv, Idx1 + Idx2 - 数字列, 数字列) = 変換数値
    
    End If
    
    数字列 = 0
   End If
  
  End If
 
 Next Idx1

End Function


突然の質問失礼します。
今大変困っておりまして・・・。アクセス初心者でいま
壁にぶつかってしまいました。色々な教本を読んでもうまく参考になるものがなくて困っております。
小数第二位の四捨五入小数点0.66などふたけたのものがあり0.70と二桁を四捨五入することは出来たのですが。

内容はといいますとテキスト内の数字を探し小数点の付いた数字を指定の桁数で四捨五入して表示できるようにしたいのです、どうプログラムを書き換えてよいものかわかりません。
色々と突然質問してしまってすみません。

アクセスは2000を使ってます。

上記の作成したプログラムを実行しますと
任意のテキストファイル参照ボタンをおしてリードし
テキスト2ボックスにテキストファイル内データが表示される。
内容は以下です

これは0.88ですが0.90になります。
これは0.19ですが0.20になります。
これは0.76ですが0.80になります。

これは四捨五入です。

というものが
四捨五入ボタンを押す事で
下記のように結果変化しテキスト3ボックスに表示されます

これは0.90ですが0.90になります。
これは0.20ですが0.20になります。
これは0.80ですが0.80になります。

これは四捨五入です。

としっかり動くのですが。ここまでは良いと致しまして。

ですが文を少し変えて
このようなふうにすると。

これは0.88ですが0.90になります。
これは0.1966ですが0.20になります。
これは0.7ですが0.80555になります。
これは0.861ですが0.90に112あ.43216なりま112b.4c3216す。

これは四捨五入です。

と、結果が

これは0.90ですが0.90になります。
これは0.2066ですが0.20になります。
これはですが0.800.80なります。
これは0.860.900.900.90ああ.4320.40ま112bb.4c3c321す。

これは四捨五入です。

0.1966は0.2066となり
0.7は消えてしまい。
0.861ですが〜  860.900.900.90ああ.4320.40ま112bb.4c3c321す。
となってしまい。

このような、大変わけのわからないものになってしまい。どこがおかしいのかも良くわかりません。

もうしわけございませんがアドバイスよろしくおねがいします。
731 hits

【11208】四捨五入のPGをもう少し工夫したいのですが。 tomomi 09/10/6(火) 9:40 質問[未読]
【11209】Re:四捨五入のPGをもう少し工夫したいので... hatena 09/10/6(火) 18:12 回答[未読]
【11211】Re:四捨五入のPGをもう少し工夫したいので... tomomi 09/10/7(水) 9:38 回答[未読]
【11212】Re:四捨五入のPGをもう少し工夫したいので... hatena 09/10/7(水) 10:09 回答[未読]
【11213】Re:四捨五入のPGをもう少し工夫したいので... tomomi 09/10/7(水) 10:49 回答[未読]
【11214】Re:四捨五入のPGをもう少し工夫したいので... 超初心者 09/10/7(水) 11:33 発言[未読]
【11215】Re:四捨五入のPGをもう少し工夫したいので... tomomi 09/10/7(水) 14:11 発言[未読]
【11216】Re:四捨五入のPGをもう少し工夫したいので... 超初心者 09/10/7(水) 15:59 発言[未読]
【11217】Re:四捨五入のPGをもう少し工夫したいので... tomomi 09/10/13(火) 10:01 お礼[未読]
【11227】Re:ちょっとひどいのでは? たん 09/10/15(木) 22:35 発言[未読]
【11228】Re:ちょっとひどいのでは? tomomi 09/10/16(金) 8:57 回答[未読]

2066 / 9994 ←次へ | 前へ→
ページ:  ┃  記事番号:
1078197
(SS)C-BOARD v3.8 is Free