[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『項目別ダブりなしの合計』（のあ）
こんにちわ。 私は下記の例3の事例とほぼ同じ集計をしたいのですが、 その集計ではDictionaryを利用する以外にもう少し簡単なものありますが？ ありましたら教えてください。よろしくお願いします。m(_ _)m http://www.eurus.dti.ne.jp/yoneyama/Excel/vba/vba_dictionary.html
例3の事例がどれか、ちょっとまぎらわしいけど、コードとしてはDictionary利用が一番簡単ですっきりしていると思う。
別案としては、たとえばフィルタオプションで重複のない一意の値を抽出しておいて、それをベースにSUMIF関数で とか。
(ぶらっと)
ぶらっとさん有難うございます。Dictionaryが一番簡単ですかぁ・・・・ フィルターコピーも検討してみます。
（のあ）
Dictionaryでいじってみましたが、何せ１/3も意味が分からないので、 うまくいくはずはないのですが、なんだか書き出しがめちゃめちゃです。どなたか助けてください（TｗT)
欲しい結果は シート８のA&B&Cのダブらない項目 HとI列の集計をシート９に書き出す はずが、 全くうまく書き出されていません。 何がどう違っているんですか?
シート８
[A] [B] [C] [D] [E] [F] [G] [H] [I] [2] 年月日 会員NO コース 詳細 出費 収入 [3] 2012/1/1 20111 1 GK 1,596 1000 [4] 2012/1/1 20112 1 GK 2,074 10000 [5] 2012/1/1 20111 2 GK 6,327 50000 [6] 2012/1/1 20112 3 GK 5,885 [7] 2012/1/1 20112 3 GG 15,612 [8] 2012/1/6 20111 3 GK 1,583 [9] 2012/1/6 20112 2 GK 4,973 [10] 2012/1/6 20111 3 GK 1,075
シート９
[A] [B] [C] [D] [E] [F] [G] 日付 会員NO コース 詳細 出費 収入 残金 [5] 2012/1/1 20111 1 GK 1,596 1000 596 [6] 2012/1/1 20112 1 GK 2,074 10000 8,522 [7] 2012/1/1 20111 2 GK 6,327 50000 52,195 [8] 2012/1/1 20112 3 GK 21,497 30,698 [9] 2012/1/6 20111 3 GK 2658 28,040 [10] 2012/1/6 20112 2 GK 4,973 23,067
Sub 集計5()
Dim myDic As Object, myKey, myItem Dim myVal, myVal2, myVal3 Dim i As Long
Set ws = Worksheets("Sheet9")
Range("M2", Range("G" & Rows.Count).End(xlUp)).ClearContents
'題名をつける
Range("M1:S1").Value = Range("A2:K2").Value
Set myDic = CreateObject("Scripting.Dictionary")
' ---元データを配列に格納
myVal = Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 11).Value
' ---myDicへデータを格納
For i = 1 To UBound(myVal, 1)
'A、B、C,E列のダブらない項目
myVal2 = myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 3) & "_" & myVal(i, 5)
'支出集計
If Not myVal2 = "_" Then
If Not myDic.exists(myVal2) Then
myDic.Add myVal2, myVal(i, 8)
Else
myDic(myVal2) = myDic(myVal2) + myVal(i, 11)
End If
End If
'収入集計
If Not myVal3 = "_" Then
If Not myDic.exists(myVal3) Then
myDic.Add myVal3, myVal(i, 9)
Else
myDic(myVal3) = myDic(myVal3) + myVal(i, 11)
End If
End If
Next
' ---Key,Itemの書き出し
myKey = myDic.keys
Range("D2").Resize(myDic.Count) = Application.WorksheetFunction.Transpose(myKey)
myKey = myDic.keys
myItem = myDic.items
For i = 0 To UBound(myKey)
myVal3 = Split(myKey(i), "_")
ws.Cells(i + 2, 1).Value = myVal3(0)
ws.Cells(i + 2, 2).Value = myVal3(1)
ws.Cells(i + 2, 3).Value = myItem(i)
Next
Set myDic = Nothing
' ---並べ替え
'Range("E1", Range("G" & Rows.Count).End(xlUp)).Sort _
'Key1:=Range("E2"), Order1:=xlAscending, _
' Key2:=Range("F2"), Order2:=xlAscending, _
'Header:=xlGuess
End Sub (のあ)
参考になさったページは 今回の件とは少し違っている様に思います。 集計したい列が前回は一列 今回は二列有りますので。
そこで、ディクショナリを少し違った使い方をしてみるのはどうでしょう。
新しい項目（myVal2）が出てきたら、その項目名と 何番目に出てきたのかの番号を ディクショナリに格納します。 myDic.Add myVal2, myDic.Count + 1 1番目に出てきたら1 2番目に出てきたら2
Sheet9へ書き出す時は、1行目にタイトル行がありますので
1番目に出てきたら2行目（1+1) 2番目に出てきたら3行目(2+1)
に書き出す事に成ります。
すぐ上で格納したのですが 何番目だったのか問合せて myDic(myVal2)
その +1 した行が書き出す行に成るので
MyRow = myDic(myVal2) + 1 としておいて
.Range("A" & MyRow).Value = myVal(i, 1) 'A列 年月日
の様に まずは共通部分を転記。
出費、収入は「元のセルの値に足す」と言う作業が必要に成るので 二回目以降に出てきた時と同じ部分で処理する事にしてみます。 二回目以降に出てきた場合は E,F列だけの変更で良いので。。。
項目を転記した時と同じ様に
何番目に出てきた物だったのか、ディクショナリに問い合わせて myDic(myVal2)
その+1 をした行にデータが有る事に成ります。 MyRow = myDic(myVal2) + 1
.Range("E" & MyRow).Value = .Range("E" & MyRow).Value + myVal(i, 8) 'H列 出費
該当セルの値 を（元々入っていた値 + myVal）した値に変更します。
'------ Sub TEST() Dim myDic As Object Dim myVal, myVal2 Dim i As Long, MyRow As Long
Set myDic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet8")
' ---元データを配列に格納
myVal = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 11).Value
End With
With Sheets("Sheet9")
' ---古いデータを削除する
.Range("A:G").ClearContents
' ---題名をつける
.Range("A1:G1").Value = Array("日付", "会員NO", "コース", "詳細", "出費", "収入", "残金")
' ---myDicへデータを格納
For i = 1 To UBound(myVal, 1)
'A、B、C,E列のダブらない項目
myVal2 = myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 3) & "_" & myVal(i, 5)
If Not myVal2 = "_" Then
If Not myDic.exists(myVal2) Then '初めて出てきたら
myDic.Add myVal2, myDic.Count + 1 'キーと何番目に出てきたかを登録
MyRow = myDic(myVal2) + 1 '書き出す行を取得
.Range("A" & MyRow).Value = myVal(i, 1) 'A列 年月日
.Range("B" & MyRow).Value = myVal(i, 2) 'B列 会員NO
.Range("C" & MyRow).Value = myVal(i, 3) 'C列 コース
.Range("D" & MyRow).Value = myVal(i, 5) 'E列 詳細
End If
MyRow = myDic(myVal2) + 1 '前回書き出した行を取り出して
.Range("E" & MyRow).Value = .Range("E" & MyRow).Value + myVal(i, 8) 'H列 出費
.Range("F" & MyRow).Value = .Range("F" & MyRow).Value + myVal(i, 9) 'I列 収入
End If
Next
End With
Set myDic = Nothing
End Sub
'------
Sheet9のセルを直接変更しているので 少し時間はかかりますが 気になる様であれば、配列処理に変更すると 時間短縮に成ると思います。
なお、残金の計算はどの様に行うのか分からなかったので空きに成ってます。
(HANA)
コメントかいてたらHANAさんと衝突。 HANAさんにお出ましいただいたので、もうＲＯＭしようかなとも思うけど メモだけ以下にアップ。
うまくいかないというのは、どこかでエラーになるのかな？（なるよね）
最初の方の Range("M1:S1").Value = Range("A2:K2").Value
これは、どのシートのどこを、どのシートのどこに（なんのために）転記しているのかな？教えて。
それと、アップされたサンプル、シート９が１行目からデータのようにも見えるけど、
データは２行目からだよね。
(ぶらっと)
＞コメントかいてたらHANAさんと衝突。 やっぱりですよね。。。タイミング的に スミマセン。 その話はまた続けて下さい。 (HANA)
賑やかですが、私も入れてください。 私なりに整理するとこんな感じ、位置関係が多少自信なし・・・。 Dic は、記入位置行番号を指定する Index として使用。 集計処理は、展開用配列 w の中で行っています。 テストはしていませんが、考え方の参考に・・・・・。
Sub Sample集計()
Dim myDic As Object
Dim v, w, x, S$
Dim i&, j&, n&
Set myDic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet8") '元データ
i = .Cells(.Rows.Count, "a").End(xlUp).Row
n = 1 '初期値
v = .Range("A2:K" & i).Value '元データを配列に格納
ReDim w(1 To UBound(v), 1 To 7) '展開用配列準備
x = Array("日付", "No", "コース", "詳細", "出費", "収入", "残金")
For i = 0 To 6
w(1, j + 1) = x(i)
Next
For i = 1 To UBound(myVal, 1)
'A,B,C,E列の結合文字
S = v(i, 1) & "_" & v(i, 2) & "_" & v(i, 3) & "_" & v(i, 5)
If Not myDic.exists(S) Then
n = n + 1
myDic(S) = n '記入位置行番号を Dic へ
For j = 1 To 3 '日付〜コース
w(n, j) = v(i, j)
Next
w(n, 4) = v(i, 5) '詳細
w(n, 5) = v(i, 8) '出費
w(n, 6) = v(i, 9) '収入
w(n, 7) = w(n, 5) - w(n, 6) '残金
Else
n = myDic(S)
w(n, 5) = w(n, 5) + v(i, 8) '出費
w(n, 6) = w(n, 6) + v(i, 9) '収入
w(n, 7) = w(n, 5) - w(n, 6) '残金
End If
Next
End With
'展開処理
With Sheets("Sheet9") '展開先
.Cells.ClearContents
.Cells(1, 1).Resize(n, 7).Value = w
End With
Set myDic = Nothing
End Sub
(HM)
＞考え方の参考に・・・・・。 と言う事ですが、Dictionaryを使う割には nの扱いが少し杜撰すぎやしませんか？
前提として ソートされてるとか？ それなら、Dictionaryなんて 使わなくても良さそうですね。 「ソートして、Dictionaryを使わない集計」マクロの方が 分かりやすいかもしれません？ そもそも ＞＞Dictionaryを利用する以外にもう少し簡単なものありますが？ ＞＞ありましたら教えてください。 って事でも有りますし。。。
(HANA)
HANAさんのご指摘通り、並び替えてループさせながら集計するほうが、のあさんにとってはわかりやすいかもね。
そうするにしても、上で聞いている疑問に加えて、以下も知りたいね。
１．集計後の例で、出費が1,596、収入が1000、残金が596 になっているけど、へんだよね？ ２．集約キーは年月日、会員番号、コースということだけど、集約表に反映する"詳細"はキーにしなくていいの？（あと勝ちとか先勝ち？）
(ぶらっと)
ということで（？）Dictionaryではないコード案を。 Sheet1,Sheet2ともに１行目がタイトル行、Sheet1はソート済み、Sheet2のタイトル行と各列の書式はセット済み、詳細は後がち、という前提。 （Sheet1については必要ならコードの中でソートをして、処理後、もとの並びに戻すこともできるけど）
Sub Sample()
Dim z As Long
Dim v() As Variant
Dim i As Long, k As Long
Dim oKey As String, nKey As String
Dim pamt As Long, ramt As Long
Dim rmk As String
Dim wk As Variant
With Sheets("Sheet1")
z = .Range("A" & .Rows.Count).End(xlUp).Row
ReDim v(1 To z - 1, 1 To 7) '集計データ用配列。行数は可能性のある最大行数。
oKey = .Range("A2").Value & vbTab & .Range("B2").Value & vbTab & .Range("C2").Value
For i = 2 To z + 1
nKey = .Range("A" & i).Value & vbTab & .Range("B" & i).Value & vbTab & .Range("C" & i).Value
If nKey <> oKey Then
k = k + 1
wk = Split(oKey, vbTab)
v(k, 1) = wk(0)
v(k, 2) = wk(1)
v(k, 3) = wk(2)
v(k, 4) = rmk
v(k, 5) = pamt
v(k, 6) = ramt
pamt = 0
ramt = 0
End If
oKey = nKey
rmk = .Range("E" & i).Value
pamt = pamt + .Range("H" & i).Value
ramt = ramt + .Range("I" & i).Value
Next
End With
With Sheets("Sheet2")
On Error Resume Next
Intersect(.UsedRange, .UsedRange.Offset(1)).ClearContents
On Error GoTo 0
.Range("A2").Resize(k, UBound(v, 2)).Value = v
.Range("G2").Resize(k).Formula = "=IF(ROW()=2,F2-E2,G1+F2-E2)"
.Select
End With
MsgBox "集計が終了しました"
End Sub
(ぶらっと)
こんなのでは？
整列を掛けて1行ずつ配列に取り込んで処理します
Option Explicit
Public Sub Sample_2()
'Sheet8の中の「年月日」と成る列位置
Const clngKey1 As Long = 1
'Sheet8の中の「会員NO」と成る列位置
Const clngKey2 As Long = 3
'Sheet8の中の「コース」と成る列位置
Const clngKey3 As Long = 2
Dim i As Long
Dim lngRows As Long
Dim lngColumns As Long
Dim lngWrite As Long
Dim rngList As Range
Dim rngResult As Range
Dim vntData As Variant
Dim vntSum As Variant
Dim vntBal As Variant
Dim strProm As String
'Sheet8の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = Worksheets("Sheet8").Range("A1")
'Sheet9の結果出力の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngResult = Worksheets("Sheet9").Range("A1")
'画面更新を停止
Application.ScreenUpdating = False
'Sheet9に就いて
With rngResult
'データをクリア
If .CurrentRegion.Rows.Count > 1 Then
Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).ClearContents
End If
End With
'Sheet8のListに就いて
With rngList.CurrentRegion
'行、列数の取得
lngRows = .Rows.Count - 1
lngColumns = .Columns.Count
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'Listを「年月日」順の「コース」順の「会員NO」順で整列
.Sort Key1:=.Cells(1, clngKey1), Order1:=xlAscending, _
Key2:=.Cells(1, clngKey2), Order2:=xlAscending, _
Key3:=.Cells(1, clngKey3), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke
End With
'Sheet8のデータ先頭行を集計用配列に取得
vntSum = rngList.Offset(1).Resize(, lngColumns).Value
'Sheet8のデータ2行目〜最終行+1まで繰り返し
For i = 2 To lngRows + 1
'1行分のデータを配列に取得
vntData = rngList.Offset(i).Resize(, lngColumns).Value
'「年月日」、「コース」、「会員NO」が同じなら
If vntData(1, clngKey1) = vntSum(1, clngKey1) _
And vntData(1, clngKey2) = vntSum(1, clngKey2) _
And vntData(1, clngKey3) = vntSum(1, clngKey3) Then
'出費、収入 を集計
vntSum(1, 8) = vntSum(1, 8) + vntData(1, 8)
vntSum(1, 9) = vntSum(1, 9) + vntData(1, 9)
Else
'データを出力用に成型
vntSum(1, 4) = vntSum(1, 5)
vntSum(1, 5) = Val(vntSum(1, 8))
vntSum(1, 6) = Val(vntSum(1, 9))
'出費 - 収入 + 残金を計算
vntSum(1, 7) = vntSum(1, 6) - vntSum(1, 5) + vntBal
'データを出力
lngWrite = lngWrite + 1
rngResult.Offset(lngWrite).Resize(, 7).Value = vntSum
'残額を保存
vntBal = vntSum(1, 7)
'読み込んだデータを集計用変数に代入
vntSum = vntData
End If
Next i
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
MsgBox strProm, vbInformation
End Sub
(Bun)
たくさんの回答有難うございます。m(_ _)M 中々回答ありませんでしたので、少しあきらめていましたが、 今日覗いたらなんとこんなにたくさん回答が・・・感激です。
ただ、大変申し訳ありませんHANAさんのを使用させて下さい。 私の脳みそでは1行ずつ処理していくしか理解できないようです。 あとありがたいことにコメント付き。
HMさんとふらっとさんBUNさんのコードはゆっくりと参考しながら勉強させてください。。
返事遅くてすみません。コード実行した際シート８に内容が書きかえられたりで、 あれやこれやをやってようやくシート９にダブり項目なしのう項目を移すことができました。
■問題点が発生 １．G列の計算がうまくいかない（ふらっとさんの数式を参考にしました。） G3=IF(ROW()=3,G3-F3,H2+G3-F3) 以降のセルもこの数式になり、計算ができない状況です。 数式はすべての行に入ってるのになぜ？ 2.なぜか残金の項目名が「０」になります。(ROW()=2が原因ですか？
シート９ 年月日 会員NO コース 詳細 出費出費 収入収入 0 [3] 2012/1/1 繰越金 0 50000 50000 [4] 2012/1/1 20111 1 GK 1596 1000 0 [5] 2012/1/1 20112 1 GK 2074 10000 0 [6] 2012/1/1 20111 2 GK 6327 50000 0 [7] 2012/1/1 20112 3 GK 5885 0 0 [8] 2012/1/1 20112 3 GG 15612 0 0
3.月ごとの小計と累計を追加しなければならないですが、 たぶんIF関数を入れるんですよね？ その場合何と比較すればいいのですか？
シート９ 年月日 会員NO コース 詳細 出費出費 収入収入 0 0 [3] 2012/1/1 繰越金 0 50000 50000 0 [4] 2012/1/1 1955/1/22 1 GK 1596 1000 0 0 [5] 2012/1/1 1955/1/23 1 GK 2074 10000 0 0 [6] 2012/1/1 1955/1/22 2 GK 6327 50000 0 0 [7] 2012/1/1 1955/1/23 3 GK 5885 0 0 0 [8] 2012/1/1 1955/1/23 3 GG 15612 0 0 0 [9] 小計 31494 111000 [10] 累計 31494 111000 79506 [11] 2012/1/6 1955/1/22 3 GK 2658 0 0 [12] 2012/1/6 1955/1/23 2 GK 4973 0 0 [13] 小計 7631 0 [14] 累計 39125 111000 71875
Sub 集計()
Dim myDic As Object Dim myVal, myVal2 Dim i As Long, MyRow As Long
Set myDic = CreateObject("Scripting.Dictionary")
Set sh9 = Worksheets("Sheet9")
With Sheets("Sheet8")
' ---元データを配列に格納
myVal = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 11).Value
End With
With Sheets("Sheet9")
' ---古いデータを削除する
.Range("A:G").ClearContents
' ---題名をつける
.Range("A2:G2").Value = Array("日付", "会員NO", "コース", "詳細", "収入", "出費", "残金")
' ---myDicへデータを格納
For i = 1 To UBound(myVal, 1)
'A、B、C,E列のダブらない項目
myVal2 = myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 3) & "_" & myVal(i, 5)
If Not myVal2 = "_" Then
If Not myDic.exists(myVal2) Then '初めて出てきたら
myDic.Add myVal2, myDic.Count + 1 'キーと何番目に出てきたかを登録
MyRow = myDic(myVal2) + 1 '書き出す行を取得
sh9.Range("A" & MyRow).Value = myVal(i, 1) 'A列 年月日
sh9.Range("B" & MyRow).Value = myVal(i, 2) 'B列 会員NO
sh9.Range("C" & MyRow).Value = myVal(i, 3) 'C列 コース
sh9.Range("D" & MyRow).Value = myVal(i, 5) 'E列 詳細
End If
MyRow = myDic(myVal2) + 1 '前回書き出した行を取り出して
sh9.Range("E" & MyRow).Value = .Range("E" & MyRow).Value + myVal(i, 9) 'H列 出費
sh9.Range("F" & MyRow).Value = .Range("F" & MyRow).Value + myVal(i, 8) 'I列 収入
End If
sh9.Range("G" & MyRow).Formula = "=IF(ROW()=3,E3-F3,G2-F3+E3)" 'G列 残金
Next
End With
Set myDic = Nothing
' ---並べ替え
'Range("A2", Range("G" & Rows.Count).End(xlUp)).Sort _
'Key1:=Range("A3"), Order1:=xlAscending, _
' Key2:=Range("B3"), Order2:=xlAscending, _
' Key3:=Range("C3"), Order3:=xlAscending, _
'Header:=xlGuess
End Sub
(のあ)寝不足で脳停止中
なかなか難しいですね。
＞3.月ごとの小計と累計を追加しなければならないですが、 と成ると、本格的に別の方法で考えていった方がよさそうです。
そうだとしても ＞1．G列の計算がうまくいかない ＞2.なぜか残金の項目名が「０」になります。 の問題は別の問題として、理解に努めても良さそうに思います。 いずれどこかで当たる問題だと思いますので。
パターン１ ついでなので、1,2の問題を解決してから これまでの方法とは違う方法で3も含めた結果が得られるコードを作成する。
パターン２ どうせ全く違ったコードに成るのなら 1,2の問題は先送りにして 先に3を含めた結果が得られるコードを作成する。
パターン３ ここまで出来ているので、1,2の問題を解決してから このコードをベースに3の結果を得られる物にする。
どの様にしたいですか？
ちなみに、一応書きましたが パターン３は良い結果に成らないと思いますので 全くお勧めしません。
(HANA)
(HANA)さん全く違うコードですか？ 今までの苦労はいったい（TwT)
そうですねパタン２がベストでしょか？
BUNさんのコードに近い感じでしょうか？ （のあ）
＞今までの苦労はいったい（TwT) でも、どんなときに どんな方法をとるのが良いのか 今後の足がかりになって 良いと思いますよ？ それぞれに利点も有りますし これからもコードを書いていくなら いつかは対面する事だと思います。
あくまでも 総合的に考えて別の方法が良いのでは？ って事で 「今の方法じゃ出来ないよ」って訳ではないので ご理解下さい。
では、パターン２の方向で。 ぶらっとさんや BUNさんのコードに近い感じですね。
さて、全体が見えない内に 部分的に作って組み合わせても 良い物にならない事が多々ありますので まずは そちらの状況を詳しく教えて下さい。
元データは ソート済みなのか？ 項目は 年月日＆会員NO＆コース＆詳細 の４つの複合で考えるのか？ 小計・累計の行の残金のセルはどの様に扱うか？ 「繰越金」のデータは元データの先頭行に書かれていたりするのか？
「こんな感じになって上手く行きません」を載せてもらえるのは有り難いのですが あわせて「これになって欲しいの！！」も載せておいてもらえると良いと思います。
(HANA)
>元データは ソート済みなのか？ ソート済みになっていません。多少に日付がづれます >繰越金」のデータは元データの先頭行に書かれていたりするのか？ 先頭に書いてあります。必ずです。 >項目は 年月日＆会員NO＆コース＆詳細 の４つの複合で考えるのか？ はいそうです。 >小計・累計の行の残金のセルはどの様に扱うか？
■元データー シート８ [A] [B] [C] [D] [E] [F] [G] [H] [I] [2] 年月日 会員NO コース クラス 詳細１ 担当者 出席 出費 収入 [3] 2012/1/1 41 繰越金 50000 [4] 2012/1/1 20111 1 GK 1,596 [5] 2012/1/2 20111 2 1000 [6] 2012/1/1 20112 1 GK 2,074 [7] 2012/1/2 20112 2 10000 [8] 2012/1/6 20112 3 GK 4,973 [9] 2012/1/1 20111 3 GK 6,327 [10] 2012/1/2 20111 4 50000 [11] 2012/1/1 20112 4 GK 5,885 [12] 2012/1/1 20112 4 GG 15,612 [13] 2012/1/6 20111 5 GK 1,583 [14] 2012/1/6 20111 5 GK 1,075 [15] 2012/2/6 20111 6 GK 1,075
■加工するシート シート９ 現在の結果
問題点 G2に「残金」ではなく「０」 月ごとの合計と累計はない 並べ替えも出来ない
[A] [B] [C] [D] [E] [F] [G] [2] 年月日 会員NO コース 詳細１ 収入 出費 0 [3] 2012/1/1 41 繰越金 50000 0 50000 [4] 2012/1/1 20111 1 GK 0 1596 0 [5] 2012/1/2 20111 2 1000 0 0 [6] 2012/1/1 20112 1 GK 0 2074 0 [7] 2012/1/2 20112 2 10000 0 0 [8] 2012/1/6 20112 3 GK 0 4973 0 [9] 2012/1/1 20111 3 GK 0 6327 0 [10] 2012/1/2 20111 4 50000 0 0 [11] 2012/1/1 20112 4 GK 0 5885 0 [12] 2012/1/1 20112 4 GG 0 15612 0 [13] 2012/1/6 20111 5 GK 0 2658 0 [14] 2012/2/6 20111 6 GK 0 1075 0 : 0 0 0
■欲しい結果 [A] [B] [C] [D] [E] [F] [G] [2] 年月日 会員NO コース 詳細１ 収入 出費 残金 [3] 2012/1/1 41 繰越金 50000 0 50000 [4] 2012/1/1 20111 1 GK 0 1596 48404 [5] 2012/1/1 20111 3 GK 0 6327 42077 [6] 2012/1/1 20112 1 GK 0 2074 40003 [7] 2012/1/1 20112 4 GK 0 5885 34118 [8] 2012/1/1 20112 4 GG 0 15612 18506 [9] 2012/1/2 20111 2 1000 0 19506 [10] 2012/1/2 20111 4 50000 0 69506 [11] 2012/1/2 20112 2 10000 0 79506 [12] 2012/1/6 20111 5 GK 0 2658 76848 [13] 2012/1/6 20112 3 GK 0 4973 71875 １月分合計 111000 39125 累計 111000 39125 71875 [14] 2012/2/6 20111 6 GK 0 1075 70800 : ２月分合計 0 1075 累計 111000 40200 70800 こんな感じです。 (のあ)
幸いと言うか今回、無精こいて行単位の集計出力なので、合計、累計の行は割と簡単に出力出来ます ただし、 処理の速度は出ませんが？
参考にでも成れば幸いです
尚、元のデータは今回、整列しっぱなしですが？ もし、元の順番に戻す必要が在るなら作業列を作って細工をすれば元の順番に戻せます また、Excelのバージョンが無かった様なので一応2003でも動く様にした積りです
Option Explicit
Public Sub Sample_3()
'Sheet8の中の「年月日」と成る列位置
Const clngKey1 As Long = 1
'Sheet8の中の「コース」と成る列位置
Const clngKey2 As Long = 2
'Sheet8の中の「会員NO」と成る列位置
Const clngKey3 As Long = 3
'Sheet8の中の「詳細１」と成る列位置
Const clngKey4 As Long = 5
Dim i As Long
Dim lngRows As Long
Dim lngColumns As Long
Dim lngWrite As Long
Dim rngList As Range
Dim rngResult As Range
Dim vntData As Variant
Dim vntBal As Variant
Dim vntSum As Variant
Dim vntMSum As Variant
Dim vntTotal As Variant
Dim strProm As String
'Sheet8の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngList = Worksheets("Sheet8").Range("A1")
'Sheet9の結果出力の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
Set rngResult = Worksheets("Sheet9").Range("A1")
'Sheet9に就いて
With rngResult
'データをクリア
If .CurrentRegion.Rows.Count > 1 Then
Intersect(.CurrentRegion, .CurrentRegion.Offset(1)).ClearContents
End If
End With
'Sheet8のListに就いて
With rngList.CurrentRegion
'行、列数の取得
lngRows = .Rows.Count - 1
lngColumns = .Columns.Count
If lngRows <= 0 Then
strProm = "データが有りません"
GoTo Wayout
End If
'Listを「年月日」順の「会員NO」順の「コース」順の「詳細１」順で整列
.Sort Key1:=.Cells(1, clngKey4), Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke
.Sort Key1:=.Cells(1, clngKey1), Order1:=xlAscending, _
Key2:=.Cells(1, clngKey2), Order2:=xlAscending, _
Key3:=.Cells(1, clngKey3), Order3:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, SortMethod:=xlStroke
End With
'画面更新を停止
Application.ScreenUpdating = False
'月合計用の配列を確保
ReDim vntMSum(1 To 3)
'累計用の配列を確保
ReDim vntTotal(1 To 4)
vntTotal(1) = "累計"
'Sheet8のデータ先頭行を集計用配列に取得
vntSum = rngList.Offset(1).Resize(, lngColumns).Value
'Sheet8のデータ2行目〜最終行+1まで繰り返し
For i = 2 To lngRows + 1
'1行分のデータを配列に取得
vntData = rngList.Offset(i).Resize(, lngColumns).Value
'「年月日」、「コース」、「会員NO」、「詳細１」が同じなら
If vntData(1, clngKey1) = vntSum(1, clngKey1) _
And vntData(1, clngKey2) = vntSum(1, clngKey2) _
And vntData(1, clngKey3) = vntSum(1, clngKey3) _
And vntData(1, clngKey4) = vntSum(1, clngKey4) Then
'出費、収入 を集計
vntSum(1, 8) = vntSum(1, 8) + vntData(1, 8)
vntSum(1, 9) = vntSum(1, 9) + vntData(1, 9)
Else
'データを出力用に成型
vntSum(1, 4) = vntSum(1, 5)
vntSum(1, 5) = Val(vntSum(1, 9))
vntSum(1, 6) = Val(vntSum(1, 8))
'出費 - 収入 + 残金を計算
vntSum(1, 7) = vntSum(1, 5) - vntSum(1, 6) + vntBal
'月合計を集計
vntMSum(2) = vntMSum(2) + vntSum(1, 5)
vntMSum(3) = vntMSum(3) + vntSum(1, 6)
'残額を保存
vntBal = vntSum(1, 7)
'データを出力
lngWrite = lngWrite + 1
rngResult.Offset(lngWrite).Resize(, 7).Value = vntSum
'月が代わったら
If Month(vntSum(1, clngKey1)) <> Month(vntData(1, clngKey1)) Then
'月合計用の配列の先頭に月を代入
vntMSum(1) = StrConv(Month(vntSum(1, clngKey1)), vbWide) & "月分合計"
'累計に月合計を加算
vntTotal(2) = vntTotal(2) + vntMSum(2)
vntTotal(3) = vntTotal(3) + vntMSum(3)
vntTotal(4) = vntBal
'月合計を出力
lngWrite = lngWrite + 1
rngResult.Offset(lngWrite, 3).Resize(, 3).Value = vntMSum
'累計を出力
lngWrite = lngWrite + 1
rngResult.Offset(lngWrite, 3).Resize(, 4).Value = vntTotal
'月合計をクリア
vntMSum(2) = 0
vntMSum(3) = 0
End If
'読み込んだデータを集計用変数に代入
vntSum = vntData
End If
Next i
strProm = "処理が完了しました"
Wayout:
'画面更新を再開
Application.ScreenUpdating = True
Set rngList = Nothing
Set rngResult = Nothing
MsgBox strProm, vbInformation
End Sub
(Bun)
あは！、善く見たらSheet8のListもSheet9の結果も列見出し「年月日」がA2なのですね！ 此れを変更するには以下の★印の様に「A1」→「A2」に変更して下さい
'Sheet8の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
' Set rngList = Worksheets("Sheet8").Range("A1")
Set rngList = Worksheets("Sheet8").Range("A2") '★変更
'Sheet9の結果出力の先頭セル位置を基準とする（先頭列の列見出しのセル位置）
' Set rngResult = Worksheets("Sheet9").Range("A1")
Set rngResult = Worksheets("Sheet9").Range("A2") '★変更
(Bun)
バグが在るのに、今気が付きました！ このままでは、データの最終行の日付が12月の場合、合計、累計が出力されません Empty値（最終行の下をダミーデータとしている為）をMonth関数で月を出している為に12月に成る為に起こります この修正は、以下の★印の様にして下さい
'月が代わったら
If Month(vntSum(1, clngKey1)) <> Month(vntData(1, clngKey1)) Then
を
If Month(vntSum(1, clngKey1)) <> Month(vntData(1, clngKey1)) _
Or IsEmpty(vntData(1, clngKey1)) Then '★変更
として下さい
(Bun)
一つずつ変数を使って計算してみます。
'------
Sub Test2()
Dim myVal As Variant
Dim SrtArr As Variant
Dim i As Long, MyRow As Long, MxRow As Long
Dim 項目収入 As Long, 項目出費 As Long, 残金 As Long
Dim 月計収入 As Long, 月計出費 As Long
Dim 累計収入 As Long, 累計出費 As Long
SrtArr = Array("E1", "C1", "B1", "A1") '←並び替えの順番を指定
With Sheets("Sheet8")
' ---元データの最終行を取得
MxRow = .Range("A" & Rows.Count).End(xlUp).Row
With .Range("A4:I" & MxRow)
' ---ソート処理
For i = 0 To UBound(SrtArr)
.Sort Key1:=.Range(SrtArr(i)), Order1:=xlAscending, _
Header:=xlNo, Orientation:=xlTopToBottom
Next i
End With
' ---元データを配列に格納
myVal = .Range("A2:I" & MxRow + 1).Value
End With
With Sheets("Sheet9")
MyRow = 2 '←2行目まで項目行
' ---3行目以降にある古いデータを削除する
.Range("A3:G" & Rows.Count).ClearContents
For i = 2 To UBound(myVal, 1) - 1
'まずは計算
項目収入 = 項目収入 + myVal(i, 9)
項目出費 = 項目出費 + myVal(i, 8)
残金 = 残金 + myVal(i, 9) - myVal(i, 8)
月計収入 = 月計収入 + myVal(i, 9)
月計出費 = 月計出費 + myVal(i, 8)
累計収入 = 累計収入 + myVal(i, 9)
累計出費 = 累計出費 + myVal(i, 8)
'一つ下の行と同じ項目でなかったら
If myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 3) & "_" & myVal(i, 5) _
<> myVal(i + 1, 1) & "_" & myVal(i + 1, 2) & "_" & myVal(i + 1, 3) & "_" & myVal(i + 1, 5) Then
'項目の転記
MyRow = MyRow + 1
.Range("A" & MyRow).Value = myVal(i, 1) '年月日
.Range("B" & MyRow).Value = myVal(i, 2) '会員NO
.Range("C" & MyRow).Value = myVal(i, 3) 'コース
.Range("D" & MyRow).Value = myVal(i, 5) '詳細1
'計算結果の書き出し
.Range("E" & MyRow).Value = 項目収入
.Range("F" & MyRow).Value = 項目出費
.Range("G" & MyRow).Value = 残金
項目収入 = 0
項目出費 = 0
End If
'一つ下の行と同じ年月でなかったら
If Format(myVal(i, 1), "yyyymm") <> Format(myVal(i + 1, 1), "yyyymm") Then
'月計の書き出し
MyRow = MyRow + 1
.Range("D" & MyRow).Value = Month(myVal(i, 1)) & "月分合計"
.Range("E" & MyRow).Value = 月計収入
.Range("F" & MyRow).Value = 月計出費
月計収入 = 0
月計出費 = 0
'累計の書き出し
MyRow = MyRow + 1
.Range("D" & MyRow).Value = "累計"
.Range("E" & MyRow).Value = 累計収入
.Range("F" & MyRow).Value = 累計出費
End If
Next
End With
End Sub
'------
元データは並べ替えっぱなしなので 元のままの並びを保持したいなら もうひと手間必要です。
(HANA)
私のも、最後のデータが12月だったら 合計等出てませんでした。。。 修正しました。 (HANA)
あは！、頭が固く成っている
'一つ下の行と同じ年月でなかったら
If Format(myVal(i, 1), "yyyymm") <> Format(myVal(i + 1, 1), "yyyymm") Then
此れが思いつきませんでした
(Bun)
HANAさん BUNさんコードをありがとうございます。すごいですね。 コピー貼り付けただけでポンと結果を得られました。感激です。（☆Δ☆）
後は４月〜翌年の３月までがひとくくりです。
思い通りの結果は得られましたが、なぜか「型が一致しません」 とコメントが出ます。 F８で確認したところ何周か書きこんでからここあたりがひかかったようなんです、 黄色くならないので正確の箇所は分かりません。 何か問題ありますか？
If Format(myVal(i, 1), "yyyymm") <> Format(myVal(i + 1, 1), "yyyymm") Then
'月計の書き出し
MyRow = MyRow + 1
sh9.Range("D" & MyRow).Value = Month(myVal(i, 1)) & "月分合計"
sh9.Range("E" & MyRow).Value = 月計収入
sh9.Range("F" & MyRow).Value = 月計出費
月計収入 = 0
月計出費 = 0
（のあ）エクセル2007 です。
Bunですが、私のコードの方でも出ますか（エラーが）？ 基本的には同じ様な事をしていますので
(Bun)
取り敢えず。。。
＞黄色くならないので正確の箇所は分かりません。 って事ですが、コードは何処に書いてますか？ 標準モジュールに置いてみて下さい。
それから、書き出した結果と 元データを見比べると どの項目まで処理されているか分かると思います。 （並べ替え後、単純に、上から順番に処理しています。） 次の項目と、余裕を見てその次の項目の範囲で 日付部分に日付以外のデータが入っていないか 確認してみて下さい。
＞後は４月〜翌年の３月までがひとくくりです。 これってもしかして、元データに数年分データが入っていて 「年度が変わる毎に年度計を出す」とか言う事ですか？
To,Bunさん ＞此れが思いつきませんでした そこは、かなり紆余曲折あったのです。。。（*/∇＼*）
(HANA)
HANAさん BUNさん 二つのコードに同じく型が一致しませんと出ます。 ＞書き出した結果と 元データを見比べると データーと合計は合っています。 最後の行だけ覚えのない数字があるんです。 しかし、モジュールにコピーしてたら何も起こりません（？？） 実際データーを入れて実践してみます。少し時間かかりますが・・・ また何かありましたら、よろしくお願いします。
＞標準モジュールに置いてみて下さい。 におくと黄色くなるんですねびっくり ＞これってもしかして、元データに数年分データが入っていて データーは一年分しかありません。
月日 伝票NO コース 詳細１ 収入 出費 残金 2012/1/1 41 繰越金 50,000 0 50,000 2012/1/1 20111 1 GK 0 1,596 48,404 2012/1/1 20111 3 GK 0 6,327 42,077 2012/1/1 20112 1 GK 0 2,074 40,003 2012/1/1 20112 4 GG 0 15,612 24,391 2012/1/1 20112 4 GK 0 5,885 18,506 2012/1/2 20111 2 1,000 0 19,506 2012/1/2 20111 4 50,000 0 69,506 2012/1/2 20112 2 10,000 0 79,506 2012/1/6 20111 5 GK 0 2,658 76,848 2012/1/6 20112 3 GK 0 4,973 71,875 1月分合計 111,000 39,125 累計 111,000 39,125 2012/2/6 20111 6 GK 0 1,075 70,800 2月分合計 0 1,075 累計 111,000 40,200 : 0 0 70,800 '■ ??合計とデーターは合っています。
'一つ下の行と同じ年月でなかったら
If Format(myVal(i, 1), "yyyymm") <> Format(myVal(i + 1, 1), "yyyymm") Then
'月計の書き出し
MyRow = MyRow + 1
sh9.Range("D" & MyRow).Value = Month(myVal(i, 1)) & "月分合計" ’■エラー１３でました。
（のあ）
＞しかし、モジュールにコピーしてたら何も起こりません（？？） モジュールって何処の事でしょう。。。
エラーメッセージが「型が一致しません」なので myVal(i, 1)ここに日付以外の物が入っている様にも思えますが。。。
実際のデータで試してみて、エラーが出た場合 [デバッグ]ボタンを押して該当行を黄色くした時 ローカルウィンドウを表示して、各変数がどの様に成っているか確認してみて下さい。
まず、iに何番が入っているか見て myValの該当個所に何が入っているか見て貰うと良いと思います。 左辺の方は関係ないと思いますので。。。
(HANA)
(HANA)さん急に仕事がどっさりときたため検証はまだできませんが、 とりあえず
＞モジュールって何処の事でしょう。。。 マクロを開き→ミクロソフトエクセルオブジェクトと標準モジュールがあるところです。
最初はミクロソフトエクセルオブジェクトのシート？のところに貼り付けました。
あとに標準モジュールのところに貼り付けカチャカチャいじったところエラーが出なくなったんです。
明確の回答できずにすみません＾＾；；
(のあ)
ご連絡 有り難う御座います。 結局、最終的に 標準モジュールにコードを置いてテストしたらエラーが出なくなった って事ですね？
本番でも上手く行くと良いですね。。。
(HANA)
(HANA)さん返事が大変遅くなりすみません。 仕事も今週いっぱいでめどがつきそうなのでまた、 いろいろと教えてください。よろしくお願いします。
いただいたコードを本番のデーターで試してみたところ 難儀なくうまくいきました。 ＼(＾０＾)／〜♪
ただ、データーが多いので、計算時間がかかります。 以前テーブルにする速いと言いましたが、 難しいですか？
（のあ）
無事に上手く行きましたか、良かったです。
でも「繰越」の行が集計に含まれていなかったですね。。。？ そちらで修正して頂けましたでしょうか？ 以下取り敢えず、Test2のコードのままでお話します。
テーブルにする件ですが。。。 myVal(i, 1) '年月日 myVal(i, 2) '会員NO myVal(i, 3) 'コース
とかのイメージが分かりますか？
元データに15行までデータが有った場合
' ---元データを配列に格納
myVal = .Range("A2:I" & MxRow + 1).Value
myVal に A2:I16 を取り込むので
myVal(1, 1) に A2セルに入っていた値
myVal(1, 2) に B2セルに入っていた値
が格納されている事に成ります。
括弧内の前部分が行数、後部分が列数を表します。
myVal(1, 1)がA1セルを表していると分かりやすいのですが 今回は A2セルから取込をしたので myVal(1 ,1)には A2セルの値が入っています。
Sheet9へ作る表ですが 現在は一つずつシートのセルに記入して居ますが 一旦変数に作っておいて 一気にシートに貼り付けた方が 時間の短縮につながります。
Sheet9用の変数名を 日本語を使って「集計」にしてみます。 Sheet9には2行目まで項目行になっているので 集計(1, 1) には A3セルに入れたい値を入れていく事に成ります。
Test2のコードでは、先頭のMyRowを 3 からにしたかった（3行目から記入だった）ので
MyRow = 2 '←2行目まで項目行
としていましたが、集計(○, 1) の行を考えた場合
1行目からで良いので これが不要に成ります。
Sheet9のシートの1行目と、変数「集計」の1行目は 一致しませんので 注意して下さい。
基本的には .Range("A" & MyRow).Value 等と成っていた所を
集計(MyRow, 1)
の様に書き替えていきます。
Sheet9のシートの1列目(A列)と、変数「集計」の1列目は 一致しますので 単純に A列→1 B列→2 C列→3 と書き換えて行ってもらえば良いです。
変数「myVal」の最後の行まで処理が済んだら Sheet9に書き出す処理に入ります。
A3セルを先頭に MyRow行分のデータを書き出します。
＞Sheet9用の変数を 日本語を使って「集計」にしてみます。 と書きましたが、先頭に Dim 集計 As Variant と書いただけでは、空っぽの箱が用意されただけです。 裏に「集計」と書いてある白紙の用紙を思い浮かべてみて下さい。
たとえば 机の上に 裏に「集計」って書いてある紙が有るでしょ あれの 1行目の1列目の場所に HANA って書いておいて と言われても、 1行目？1列目？そんな升目無いんだけど？何処に書いておけば良いの？ って成りますよね。
列数は分かっています。 A列からG列なので、7列分です。
行数は微妙な感じです。 データ行数から算出しようと思った時、最大で必要な行数を考えると 元データに重複が無く、一月分ずつしかデータが無かった場合 1行に付き2行（合計行と累計行）加算されていくので 元データの3倍のスペースを確保しておけば 事は足りそうです。
元データが
1行目 項目行
2行目 繰越金
3行目 1/1
4行目 2/1
・・・・・・以下○月1日のデータのみ
14行目 12/1
と成っていたら、集計は
1行目 1/1
2行目 1月分合計
3行目 累計
4行目 2/1
5行目 2月分合計
6行目 累計
・・・・・・
の様に、1行が3行に成ります。
値を入れ始める迄に ReDim 集計(1 To MxRow * 3, 1 To 7) と、用紙に罫線を入れておきます。
実際は 罫線を引く行数は MyRow * 3 よりも少なくて済みます。 元データも多い様ですし、もしもここでエラーが出るようなら もう少し妥当な値を算出するのが良いと思います。
って事で。。。↓は、繰越も転記されるよう修正。。。
'------
Sub Test3()
Dim myVal As Variant
Dim SrtArr As Variant
Dim i As Long, MyRow As Long, MxRow As Long
Dim 項目収入 As Long, 項目出費 As Long, 残金 As Long
Dim 月計収入 As Long, 月計出費 As Long
Dim 累計収入 As Long, 累計出費 As Long
Dim 集計 As Variant
SrtArr = Array("E1", "C1", "B1", "A1") '←優先順位の低い順に指定
With Sheets("Sheet8")
' ---元データの最終行を取得
MxRow = .Range("A" & Rows.Count).End(xlUp).Row
With .Range("A4:I" & MxRow)
' ---ソート処理
For i = 0 To UBound(SrtArr)
.Sort Key1:=.Range(SrtArr(i)), Order1:=xlAscending, _
Header:=xlNo, Orientation:=xlTopToBottom
Next i
End With
' ---元データを配列に格納
myVal = .Range("A1:I" & MxRow + 1).Value
End With
ReDim 集計(1 To MxRow * 3, 1 To 7)
For i = 2 To UBound(myVal, 1) - 1
'まずは計算
項目収入 = 項目収入 + myVal(i, 9)
項目出費 = 項目出費 + myVal(i, 8)
残金 = 残金 + myVal(i, 9) - myVal(i, 8)
月計収入 = 月計収入 + myVal(i, 9)
月計出費 = 月計出費 + myVal(i, 8)
累計収入 = 累計収入 + myVal(i, 9)
累計出費 = 累計出費 + myVal(i, 8)
'一つ下の行と同じ項目でなかったら
If myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 3) & "_" & myVal(i, 5) _
<> myVal(i + 1, 1) & "_" & myVal(i + 1, 2) & "_" & myVal(i + 1, 3) & "_" & myVal(i + 1, 5) Then
'項目の転記
MyRow = MyRow + 1
集計(MyRow, 1) = myVal(i, 1) '年月日
集計(MyRow, 2) = myVal(i, 2) '会員NO
集計(MyRow, 3) = myVal(i, 3) 'コース
集計(MyRow, 4) = myVal(i, 5) '詳細1
'計算結果の書き出し
集計(MyRow, 5) = 項目収入
集計(MyRow, 6) = 項目出費
集計(MyRow, 7) = 残金
項目収入 = 0
項目出費 = 0
End If
'一つ下の行と同じ年月でなかったら
If Format(myVal(i, 1), "yyyymm") <> Format(myVal(i + 1, 1), "yyyymm") Then
'月計の書き出し
MyRow = MyRow + 1
集計(MyRow, 4) = Month(myVal(i, 1)) & "月分合計"
集計(MyRow, 5) = 月計収入
集計(MyRow, 6) = 月計出費
月計収入 = 0
月計出費 = 0
'累計の書き出し
MyRow = MyRow + 1
集計(MyRow, 4) = "累計"
集計(MyRow, 5) = 累計収入
集計(MyRow, 6) = 累計出費
End If
Next
With Sheets("Sheet9")
' ---3行目以降にある古いデータを削除する
.Range("A3:G" & Rows.Count).ClearContents
' ---データを書き出す
.Range("A3").Resize(MyRow, 7) = 集計
End With
End Sub
'------
(HANA)
HANAさん有難うございます。すごいです。一瞬に計算ができ上がりました。
繰り越しは出ていますよ＾＾ 頂いたコードを少し変更しながら、使用しています。
１１行目が空欄の行をすべて書き出すようににしてるので? 欲しい結果はすべて出ていますよ＾＾
コードの説明もしていただいたおかげで変更した部分のみ 組み入れることができました。VBAもなかなか奥が深いですね。 本当に感謝でいっぱいです。 m(_ _)m
If myVal(i, 1) & "_" & myVal(i, 2) & "_" & myVal(i, 3) & "_" & myVal(i, 4) _
<> myVal(i + 1, 1) & "_" & myVal(i + 1, 2) & "_" & myVal(i + 1, 3) & "_" & myVal(i + 1, 4) Then
If myVal(i, 11) = "" Then '11列目が空欄の項目すべて書き出す
'項目の転記
MyRow = MyRow + 1
集計(MyRow, 1) = myVal(i, 1) '年月日
集計(MyRow, 2) = myVal(i, 2) '会員NO
集計(MyRow, 3) = myVal(i, 3) 'コース
集計(MyRow, 4) = myVal(i, 4) '詳細1
'計算結果の書き出し
集計(MyRow, 5) = 項目収入
集計(MyRow, 6) = 項目出費
集計(MyRow, 7) = 残金
項目収入 = 0
項目出費 = 0
End If
End If
のあ
繰越 出せてましたか。 昨日Test2を動かした時に出てなかったので。。。
＞頂いたコードを少し変更しながら、使用しています。 どんどん変更しながら、使いやすく＆分かりやすくして 使ってもらえると良いと思います。
セルへのアクセスは時間がかかる原因の代表的な一つです。 これからも色々なコードを作って行かれる事と思いますので 少し念頭に置いておいて貰うと良いかもしれません。
(HANA)
HANAさん有難うございます。 早速もう一つ作るところです。＾＾ 素晴らしいと上司が絶賛です。 これからも少しずつ勉強していきたいと思います。
また何かありましたら教えてください。 ここまで丁寧にお付き合いいただき本当にありがとうございます。＾＾
のあ
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.