コマンドボタンでの自動計算マクロを組みたいのですが。

一か月分の売上を納品伝票ごとに合計を計算するマクロを作りたいのです。
以下のようなワークシートで
(例1)
コード　商品名　　数量　単価　売上額　伝票合計
1111　　商品A　　　　3　1050　　3150
1112　　商品B　　　　1　2100　　2100　　　
1113　　商品C　　　　2　 840　　1680
　　　　　　　　
　　　　　　　　　↓

(例2)
コード　商品名　　数量　単価　売上額　伝票合計
1111　　商品A　　　　3　1050　　3150
1112　　商品B　　　　1　2100　　2100　　　
1113　　商品C　　　　2　 840　　1680　　6930←←※

※を計算したいのです。

自分で開始の行を指定して(2列目)作ったのが下記のマクロです。
Sub Test()
Dim i As Long ' カウンター
Dim n As Long ' 計算開始の行
n =2

For i = n To n + 6 Step 1
If Cells(i + 1, 5) = "" Then
' -------------
「合計」の計算
' -------------
合計 = Application.WorksheetFunction.Sum _
　　　　　　　　　(Range(Cells(i - (i - n), 5), Cells(i, 5)))
Range(Cells(i, 6), Cells(i, 6)).Value = 合計
Exit Sub
End If
Next i
End Sub

納品伝票は1枚最大7行で、記載行数は一定ではありません。
必ず１枚ごとに合計を出します。
ですので、売上額が入力されていない行を探し、
その直前までの合計を出すという考えで作りました。

ｎは一定ではなく不規則に増えていきます。
ｎをどのように設定すればよいでしょうか？
初心者なりに色々と試行錯誤しているのですが上手くいきません。
どうか助けてください、お願い致します。

また、タイトルにはありませんが、
UserFormでのListBoxで複数列表示するよう設定している場合
列ごとに右寄せ左寄せを変更することはできるのでしょうか？
文字列と桁の違う数列があって見にくいのです。
できるなら方法も教えていただきたいです。

(リストボックス1)
コード　商品名　　単価
1111　　商品A　　 1050　　
1112　　商品B　　 2100　　　　　
1113　　商品C　　 840　　　
1114　　商品D　　 63　　　
　　　　↓
(リストボックス2)
コード　商品名　　単価
1111　　商品A　　 1050　　
1112　　商品B　　 2100　　　　　
1113　　商品C　　 　840　※　　
1114　　商品D　　 　 63　※　単価を右寄せしたいのです。

２週間ほど悩んでますがどうにもなりません。
何卒、宜しくお願い致します。

No.5 ベストアンサー 回答者： papayuka 回答日時： 2008/05/01 12:56

#2です。

参考程度に。

シート名 Sheet1 が 先のデータベース
シート名 Sheet2 が 単価表

として、Sheet2 のA:C列は下記のような表があるとします。

コード　　商品名　　単価
1111　　　商品A　　　1050
1112　　　商品B　　　2100
1113　　　商品C　　　840
1114　　　商品D　　　600



標準モジュールではなく シートモジュールに記載します。
（シート名タブで右クリック、コードの表示を選択し、出てきたVBE画面に転記）

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim r As Range, fr As Range

On Error Resume Next
For Each r In Target
　If r.Row > 1 Then
　 Application.EnableEvents = False
　 Select Case r.Column
　 Case 1
　　 With Worksheets("Sheet2")
　　　　Set fr = .Columns(1).Find(what:=r.Value, after:=.Range("A65536"), Lookat:=xlWhole)
　　　　If Not fr Is Nothing Then
　　　　　 r.Offset(0, 1).Value = fr.Offset(0, 1).Value
　　　　　 r.Offset(0, 3).Value = fr.Offset(0, 2).Value
　　　　　 r.Offset(0, 2).Activate
　　　　End If
　　 End With
　 Case 3:
　　 r.Offset(0, 2).Value = r.Value * r.Offset(0, 1).Value
　　 r.Offset(0, 3).Activate
　 Case 6:
　　 If r.Value = 1 Then
　　　With Me
　　　　 r.Value = ""
　　　　 r.Value = _
　　　　　 Application.Sum(.Range(.Cells(r.End(xlUp).Offset(1, 0).Row, 5), .Cells(r.Row, 5)))
　　　　
　　　End With
　　 ElseIf r.Value = 0 Then
　　　　r.Value = ""
　　 End If
　　 r.Offset(1, -5).Activate
　　 End Select
　 End If
Next r

Application.EnableEvents = True

End Sub

---
Sheet1の A列とC列とF列のみ入力
F列は 1 を入力するとそれまでの合計を算出、0を入力すると何もせずに次の行へ

この回答へのお礼

やってみました！！
この方が一連の入力の流れで計算できるので
毎回ボタンをクリックするよりも楽で素敵です。

お返事が遅くなりましたが、
素敵な方法を教えてくださりありがとうございました。

お礼日時：2008/05/07 23:41

No.4 回答者： papayuka 回答日時： 2008/04/29 11:35

#2です。

1枚の伝票ってのが良く解りません。
Sheet1 に 500件分の計算式が入っている？
でも最大 7件しか使わない？

データの構造が読む者に伝わってません。
ご自身が掲示されたコードは上手く動いているのでしょうか？
最終判定やスタート判定をするためには、何らかの 「違い」 が必要です。

私が提示した先のサンプルでは

計算開始行を F列の最終行 + 1 ・・・ 前回までの合計が入っているひとつ下
計算終了行を E列の最終行 ・・・・・ 売上額が入っている最終行

として、7行を超えない範囲で合計を出しています。

例えば、E列は予め計算式を入れてあるが「コード～単価」までは毎回入力する。
最大 7行入力したら ボタンを押して合計を入れる

と言う運用ならば

　LastRecord = .Cells(.Rows.Count, 5).End(xlUp).Row
　　　　↓
　LastRecord = .Cells(.Rows.Count, 1).End(xlUp).Row

に変えれば、計算終了行が A列の最終行になります。

同じ考えでご自身が提示されたコードを修正すると下記になりますが、、、

Sub Test()
Dim i As Long ' カウンター
Dim n As Long ' 計算開始の行
'n = 2
　n = Cells(65536, 6).End(xlUp).Row + 1
　　For i = n To n + 6 Step 1
　　　　If Cells(i + 1, 1) = "" Then
　　　　　' -------------
　　　　　'「合計」の計算
　　　　　' -------------
　　　　　 合計 = Application.WorksheetFunction.Sum _
　　　　　　　　　　(Range(Cells(i - (i - n), 5), Cells(i, 5)))
　　　　　 Range(Cells(i, 6), Cells(i, 6)).Value = 合計
　　　　　 Exit Sub
　　　　End If
　　Next i
End Sub

この回答へのお礼

できました！！本当にありがとうございます！！
前回のpapavuka様の回答で「もしかして？」と思うところがあり、
自分なりに試してみたら、今回の回答くださった内容に落ちついていました。

勉強不足なうえ現状を上手く伝えられず、ご迷惑をおかけしました。
今更ですが、軽く補足いたします。

毎日、納品伝票(データではなく紙）が複数枚発生します。
納品伝票には最大７件までの内容が書いてあります。

この納品伝票の内容を１枚分づつワークシートに入力していきます。
(ワークシートは500件入力できるように作成してあります）

入力は[コード]と[数量]のみです。
[商品]と[単価]には参照の式が、[売上額]には数量＊単価の式が入っています。

そして、１枚分の納品伝票を入力したら合計を出したかったのです。
(合計を出したら、行を開けずに次の伝票内容を入力します。）

当初、計算の開始位置と終了位置を探すのに、
開始位置が分かっていたら、という仮定の下
終了位置は売上額""を探してその上までを合計すると考えてしまったんです。
売上額""は開始位置から7回（n To n + 6 Step 1)繰り返して探せばいいと思いました。

ですが、そんな事しなくても終了位置を簡単に指定できたのですね！！
そして、ただ足せば良かったのですね。

Sub aaa()
Dim LastRecord As Long, LastSum As Long
With ActiveSheet
　LastRecord = .Cells(.Rows.Count, 1).End(xlUp).Row
　LastSum = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
　.Cells(LastRecord, 6) = _
　　　　 Application.Sum(.Range(.Cells(LastSum, 5), .Cells(LastRecord, 5)))
End With
End Sub

言い訳が長くなりましたが、教えてくださって本当にありがとうございました。

お礼日時：2008/04/30 23:56

No.3 回答者： keirika 回答日時： 2008/04/29 09:34

#1です。

コード　商品名　　数量　単価　売上額　伝票合計
1111　　商品A　　　　3　1050　　3150
1112　　商品B　　　　1　2100　　2100　　　
1113　　商品C　　　　2　 840　　1680　　6930

1114　　商品D　　　　2　2500　　5000
1112　　商品B　　　　1　2100　　2100　　　
1113　　商品C　　　　2　 840　　1680　　8780

伝票と伝票の境目に空白行があり
売上額の空白行には数量＊単価が入力されているが
コードの部分の空白行には何も値が入っていない。
この条件で伝票合計の値を求める。

上記のように考えてよろしいのでしょうか。

この回答へのお礼

お返事ありがとうございました。

ｋeirika様がおっしゃるように、伝票と伝票の間に空白行があり、
コードの部分の空白行には値が入っていなければ、
複数伝票枚数分の各々合計を一気に出すことも可能なのでしょうか…？

papavuka様の意見を参考に何とか解決することはできましたが、
他に良い参考等ございましたら教えていただければ幸いです。

お礼日時：2008/04/30 23:54

No.2 回答者： papayuka 回答日時： 2008/04/29 01:38

7行毎に合計を入れていき、最終行は7行未満になる事があるって意味ですか？

Sub aaa()
Dim LastRecord As Long, LastSum As Long
With ActiveSheet
　LastRecord = .Cells(.Rows.Count, 5).End(xlUp).Row
　LastSum = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
　　Do While LastRecord >= LastSum + 6
　　　 .Cells(LastSum + 6, 6) = _
　　　　　 Application.Sum(.Range(.Cells(LastSum, 5), .Cells(LastSum + 6, 5)))
　　　 LastSum = .Cells(.Rows.Count, 6).End(xlUp).Row + 1
　　Loop
　　 .Cells(LastRecord, 6) = _
　　　　 Application.Sum(.Range(.Cells(LastSum, 5), .Cells(LastRecord, 5)))
End With
End Sub

ListBoxの件はわかりません。

この回答への補足

早々の回答ありがとうございます。
毎回７行ではなく、最大７行なのです。
１枚の伝票ごとの合計を出したいと思っており、
１枚の伝票で内容が１行の時もあれば、３行の時もあります。
１～７行の間で、不規則なのです。
ですので、毎日１枚の伝票を入力する度にコマンドボタンクリックで
合計を出そうと思っているのです。


毎回変わる計算開始行をなんとか指定できないかと悩んでいます。

なんとかなりますでしょうか？

補足日時：2008/04/29 03:08

No.1 回答者： keirika 回答日時： 2008/04/28 23:58

シート名をSheet1とします。

Sub Test()

Dim Uriage As Range

Sheets("Sheet1").Cells(2, 5).Select

Set Uriage = Range(Selection, Selection.End(xlDown))

Sheets("Sheet1").Cells(Uriage.Rows.Count + 1, 6) = _
Application.Sum(Uriage)

Set Uriage = Nothing

End Sub

この回答への補足

早々の回答ありがとうどざいます。
Sheet1が500件くらいの表になっており、
売上の列には[数量]×[単価]の式が最終行まで入っています。
Countで最終行をとると500件目に合計が出てしまうのです。
式も値も入っていない単価の列でCountを使ってみたのですが結果は同じでした。

何とか上から数える方法はないでしょうか？

補足日時：2008/04/29 02:59