Excel VBA質問箱 IV

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

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


3178 / 13644 ツリー ←次へ | 前へ→

【63727】ユーザーフォームでの計算 やまあらし 09/12/3(木) 18:50 質問[未読]
【63728】Re:ユーザーフォームでの計算 kanabun 09/12/3(木) 20:09 発言[未読]
【63729】Re:ユーザーフォームでの計算 kanabun 09/12/3(木) 20:29 発言[未読]
【63731】Re:ユーザーフォームでの計算 kanabun 09/12/4(金) 15:38 発言[未読]
【63732】Re:ユーザーフォームでの計算 やまあらし 09/12/4(金) 16:43 お礼[未読]

【63727】ユーザーフォームでの計算
質問  やまあらし  - 09/12/3(木) 18:50 -

引用なし
パスワード
   こんにちは 見よう見まねでプログラムを組んでる初心者です。

今まで、エクセルのセル上で関数で計算していたのを、なぜかしりませんが
ユーザーフォームを使ってやることになりました。
セルに関数を入れれば簡単に計算できたのに、今ユーザーフォームのテキストボックスで同じ計算をやろうとしていますが、いきずまりました。
どなたか、お知恵を拝借してください。

項目は40こあります
テキストボックの名前は
txtBox1〜txtBox40にしてあります。
それぞれのtxtBoxには個数が入るようになっています。
さらに 

txt預かり金額
txt合計金額
txtおつり金額

という3つのテキストボックスを用意し、
txt預かり金額 に金額を入力
txtBox1〜40 にそれぞれ個数を入力(すべてのtxtBoxに個数が入力されるわけではありません)すると

txt合計金額には合計金額
(txtBox1〜40には個々に金額が設定してあり、txtBox1に「3」と入力すると 450円×3 txtBox2に「5」と入力すると 500円×5 と言う風に、それぞれのtxtBoxでの金額はきまっています。その合計額を、txt合計金額に 入れるということです。)
txtおつり金額 には txt預かり金額-txt合計金額 の値

txtBox1〜40のどれかの値が、変更するたびに
txt合計金額 と txtおつり金額 の値が変わるように
できますか?

txtBoxの 1〜40 を 変数にして、for文で40回まわせばよいかなと思ったのですが、なにぶん金額設定がそれぞれ違うもので、いきずまりました。

ユーザーフォームでも、てっきり組込み関数が設定できると思っていたのですが
どうやら無理みたいですよね?

なんとかお知恵を拝借願います。

【63728】Re:ユーザーフォームでの計算
発言  kanabun  - 09/12/3(木) 20:09 -

引用なし
パスワード
   ▼やまあらし さん:
こんにちは。

それらのTextBoxをシートのセルとリンクさせて
シート上で計算させたらどうでしょう

隠しシートを使います
(このシートはUserFormを開くとき、存在チェックし、
 まだ無ければ、作成することにします。)

以下は TextBoxが1〜10 の例です。

隠しシートのA列とTextBox を連動させることにします。
  TextBox1に 個数を入力すると、値はただちにシートの[A1]セルに
  反映されます。
  以下同様にして
   TextBox2 ⇔ 隠しシート[A2]
   TextBox3 ⇔ 隠しシート[A3]
    :      :
  という具合です。

隠しシートのB列に単価を書き入れておきます。
また [C2]セルには =SUMPRODUCT式を入力し 合計金額を計算させます
また [C3]セルは おつりを算出する数式 =C1-C2 を入れておきます。

こうしておくと、txt預かり金額をアクティブにすると
txt合計金額に SUMPRODUCTで計算された合計金額が表示されますので
それを参照しながら 預かり金額を入力することができます。

'--------------------------------------
Option Explicit

Private WkSheet As Worksheet

Private Sub UserForm_Initialize()
  Dim i As Long
  On Error Resume Next
   Set WkSheet = Worksheets("Hidden")
  On Error GoTo 0
  If WkSheet Is Nothing Then
    Set WkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    With WkSheet
      .Name = "Hidden"
      .Visible = False
      .[B1:B10].Value = Application.Transpose( _
        Array(150, 200, 300, 98, 198, 298, 398, 200, 150, 300))
      .[C2].Formula = "=SUMPRODUCT(A1:A10,B1:B10)"
      .[C3].Formula = "=C1-C2"
    End With
  End If
  WkSheet.[A1:A40].ClearContents
  For i = 1 To 10 '40
    Me("TextBox" & i).ControlSource = "Hidden!A" & i
  Next
End Sub

Private Sub txt預かり金額_Enter()
  txt合計金額.Text = Range("Hidden!C2").Value
End Sub

Private Sub txt預かり金額_Change()
  Range("Hidden!C1").Value = Val(txt預かり金額.Text)
End Sub

Private Sub txt預かり金額_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  txt合計金額.Text = Range("Hidden!C2").Value
  txtおつり金額.Text = Range("Hidden!C3").Value
End Sub

【63729】Re:ユーザーフォームでの計算
発言  kanabun  - 09/12/3(木) 20:29 -

引用なし
パスワード
   ▼やまあらし さん:

あと、
>txtBox1〜40のどれかの値が、変更するたびに
>txt合計金額 と txtおつり金額 の値が変わるように
>できますか?

については、隠しシートのChangeイベントプロシージャに
以下のような記述をしておけば連動すると思いますけど

'--------------------------------- シート「Hidden」
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
  If DoEvents Then
    Dim r As Range
    Set r = Intersect(Target, [A1:A50])
    If Not r Is Nothing Then
      UserForm1.txt合計金額.Text = [C2].Value
    End If
  End If
End Sub

【63731】Re:ユーザーフォームでの計算
発言  kanabun  - 09/12/4(金) 15:38 -

引用なし
パスワード
   ▼やまあらし さん:

>txtBox1〜40のどれかの値が、変更するたびに
>txt合計金額 と txtおつり金額 の値が変わるように
>できますか?

前のサンプルでは 隠しシートのChangeイベントプロシージャ
に、セルの値が変更したら シートの[C2]セルの合計金額を
UserFormの txt合計金額 に転記する処理を書いてましたが、
シートのほうに書かずに UserForm内に書いて同じことが
できましたね。
  (以下、そのサンプルです。 隠しシートのイベント
   プロシージャのほうは 削除しちゃってお試しください)
'---------------------------------------
Option Explicit

Private WithEvents WkSheet As Excel.Worksheet  '◆ 変更

Private Sub UserForm_Initialize()
  Dim i As Long
  On Error Resume Next
   Set WkSheet = Worksheets("Hidden")
  On Error GoTo 0
  If WkSheet Is Nothing Then
    Set WkSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    With WkSheet
      .Name = "Hidden"
      .Visible = False
      .[B1:B10].Value = Application.Transpose( _
        Array(150, 200, 300, 98, 198, 298, 398, 200, 150, 300))
      .[C2].Formula = "=SUMPRODUCT(A1:A10,B1:B10)"
      .[C3].Formula = "=C1-C2"
    End With
  End If
  WkSheet.[A1:A40].ClearContents
  For i = 1 To 10 '40
    Me("TextBox" & i).ControlSource = "Hidden!A" & i
  Next
End Sub

Private Sub txt預かり金額_Enter()
  txt合計金額.Text = Range("Hidden!C2").Value
End Sub

Private Sub txt預かり金額_Change()
  Range("Hidden!C1").Value = Val(txt預かり金額.Text)
End Sub

Private Sub txt預かり金額_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  txt合計金額.Text = Range("Hidden!C2").Value
  txtおつり金額.Text = Range("Hidden!C3").Value
End Sub

Private Sub WkSheet_Change(ByVal Target As Range) '◆追加
  Dim r As Range
  Set r = Intersect(Target, WkSheet.[A1:A40])
  If Not r Is Nothing Then
    txt合計金額.Text = WkSheet.[C2].Value
  End If
End Sub

【63732】Re:ユーザーフォームでの計算
お礼  やまあらし  - 09/12/4(金) 16:43 -

引用なし
パスワード
   ▼kanabun さん:

ご丁寧にありがとうございました。
何とかできました(^^♪

それにしても ユーザーフォームで計算することがこんなに難しいとは思っても見ませんでした。
精進します。^^
ありがとうでした^^

3178 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free