Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

51553 / 76732

←次へ　｜　前へ→


	【30042】Re:データの小計をだしたい

kobasan - 05/10/18(火) 19:01 -


	引用なし

	パスワード

▼ゆりさん　今晩は

前半コードをよく理解してないので、多分ですが、
以下のコードを同じモジュールに入れると、できると思います。
変更箇所は

　　'※　
　　 main
　　'※　
のところだけですむと思います。
うまくいかなかったら、質問してください

>Sub main()
>Dim u
>　　u = Array(集計(1), 集計(2), 集計(3), 集計(4), 集計(5), 集計(6), 集計(7), 集計(8), 集計(9))
>　
>　　Sheets("sheet2").Cells(1, 1).Resize(UBound(集計(1)) + 1, UBound(u) + 1).Value _
>　　　　　　　　　　　　= Application.Transpose(u)
>　　　　　　
>End Sub
>
>Private Function 集計(clmn As Long) As Variant
>　　Dim rngA As Range
>　　Dim Dic As Object
>　　Dim r As Range
>
>　　Sheets("sheet1").Select
>　　Set rngA = ActiveSheet.Range("b2", Range("b65536").End(xlUp))
>　　Set Dic = CreateObject("Scripting.Dictionary")
>
>　　For Each r In rngA.Cells
>　　　　If clmn = 1 Then
>　　　　　　Dic.Item(r.Text) = r.Text　 'A列について
>　　　　Else
>　　　　　　Dic.Item(r.Text) = Dic.Item(r.Text) + r.Offset(, clmn - 1).Value
>　　　　End If
>　　Next
>　　集計 = Dic.items()
>　　'
>　　Set r = Nothing
>　　Set Dic = Nothing
>　　Set rngA = Nothing
>End Function
>

>
>Sub 集計_1()
>
>　　Dim 日付 As Date
>　　Dim レコード数 As Integer
>　　Dim i, N As Integer
>　　Dim Ws As Worksheet, Fi As Range, R As Range, C As Range, Ad As String
>
>　　Sheets("sheet1").Select
>　　Range("b2:j1000").Value = ""
>　　Sheets("sheet2").Select
>　　Range("b2:j1000").Value = ""
>　　
>　　日付 = Sheets("印刷").Range("c4").Value
>　　
>　　Sheets("データベース").Select
>　　レコード数 = Range("a2").CurrentRegion.Rows.Count - 1
>　　
>　　i = 0
>　　
>　　For N = 3 To レコード数 + 2
>　　　　Sheets("データベース").Select
>　　　　If Month(Cells(N, 4).Value) = Month(日付) Then
>　　　　　If Year(Cells(N, 4).Value) = Year(日付) Then
>　　　　　　If Cells(N, 2).Value = 1 Then
>　　　　
>　　　　　　Sheets("データベース").Select
>　　　　　　Cells(N, 5).Range("a1:l1").Select
>　　　　　　Selection.Copy
>　　　　　　Sheets("sheet1").Select
>　　　　　　Cells(2 + i, 2).Select
>　　　　　　ActiveSheet.Paste
>　　　　　　Application.CutCopyMode = False
>　　　　　　i = i + 1
>　　　　　　
>　　　　　　 End If
>　　　　　　End If
>　　　　 End If
>　　Next N
>　　　　　　
>　　Sheets("sheet1").Select
>　　Range("B2:J1000").Select
>　　Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, _
>　　　　OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
>　　　　:=xlPinYin
>
>
　　'※　
　　 main
　　'※　
>
>
>　Sheets("sheet1").Select
>　Range("a1").Select
>　Sheets("データベース").Select
>　Range("a1").Select
>　Sheets("印刷").Select
>　Range("a1").Select
>　
>　　
>End Sub

1 hits

▼

【29829】データの小計をだしたい ゆり 05/10/14(金) 14:46