[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『集計をマクロでやりたい』（令和２０）
[[20190528114100]] 『集計をマクロでやりたい』（令和２０）
2019年05月28日(火)
上記のように、以前質問致しまして、下記のようにご回答頂いたものです。
順調に処理を重ねて来ましたが、項目欄(日付・当該番号・品名・・・・・・)
の行とデータとの間に、集計などの行を改めて設けます。
すると、「実行時エラー"13" 型が一致しません」と出てしまいます。
どのように修正したらよいのか、お教え下さいませんか。
なお、以前（隠居じーさん）・ （白茶）のお二人には大変お世話になりありがとうございました。
A B C D E F G H I J K L M N O P Q R S T U
1 日付 当該番号 品名 金額品名 番号 品名 日付 1りんご金額 日付 2ぶどう金額 日付 3バナナ金額 日付 4みかん金額
2 3月12日 2 ぶどう 100 1 りんご 4月16日 300 3月12日 100 5月13日 500 5月12日 400
3 4月16日 1 りんご 200 2 ぶどう 4月19日 200
4 4月19日 1 りんご 300 3 バナナ
5 5月12日 4 みかん 400 4 みかん
6 5月13日 3 バナナ 500
回答ではありません。＾＾；
整理のお手伝いです。
Ｂ１〜Ｊ６の情報を基にＮ列〜Ｕ列。。（。商品数分（40）増える）
の様な表を作成すればよいのでしょうか。
ｉ〜Ｊ（商品マスタ）も作る？作らなくても良い？
とかが解ると多数回答があるかもしれませんね。
上記の図も想像図ですので、違えてましたら修正後
さらなるご説明をされるといいと思います。
私が作りますっていう意味では有りません。＾＾；；；
気が付いた点だけですみません。m(_ _)m
（隠居じーさん） 2019/05/28(火) 15:39
Sub test()
Dim DT As Range, vRead() As Variant, r As Long, vWrite() As Variant
Dim List As Range, c As Long, d As Date, r2 As Long
Dim r2HWM As Long, c2HWM As Long
Set List = [I2:J41]
c2HWM = List.Rows.Count * 2
Set DT = Intersect([B:F], [D1].CurrentRegion.EntireRow)
With Workbooks.Add
DT.Copy .ActiveSheet.Cells(1, 1)
With .ActiveSheet.Sort
.SortFields.Add Key:=Range("C1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange .Parent.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
vRead = .Rng.Value
End With
.Close False
End With
ReDim vWrite(1 To UBound(vRead), 1 To c2HWM)
For c = 2 To c2HWM Step 2
vWrite(1, c - 1) = "日付"
vWrite(1, c) = List(c / 2, 1) & List(c / 2, 2) & "金額"
Next
For r = 2 To UBound(vRead)
If vRead(r, 3) <> c Then
c = WorksheetFunction.Match(vRead(r, 3), List.Columns(1), 0)
If r2 > r2HWM Then r2HWM = r2
r2 = 1
End If
If CDate(vRead(r, 1)) <> d Then
d = CDate(vRead(r, 1))
r2 = r2 + 1
vWrite(r2, c * 2 - 1) = d
End If
vWrite(r2, c * 2) = vWrite(r2, c * 2) + vRead(r, 5)
Next
[N1].Resize(r2HWM, c2HWM) = vWrite
End Sub
（白茶） 2019/05/28(火) 16:48
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
データが B-E列、結果を N列から。 結果は、横軸は当該番号、縦軸は日付でどちらも昇順。
ということで
Sub test()
Dim a, i As Long, ii As Long, t As Long, maxRow As Long
a = Range("b2", Range("b" & Rows.Count).End(xlUp)).Resize(, 6).Value
With CreateObject("System.Collections.SortedList")
For i = 1 To UBound(a, 1)
If Not .Contains(a(i, 2)) Then
.Item(a(i, 2)) = Array(a(i, 2) & a(i, 3), _
CreateObject("System.Collections.SortedList"))
End If
.Item(a(i, 2))(1)(a(i, 1)) = .Item(a(i, 2))(1)(a(i, 1)) + a(i, 4)
Next
ReDim a(1 To UBound(a, 1), 1 To .Count * 2)
For i = 0 To .Count - 1
t = t + 2
a(1, t - 1) = "日付": a(1, t) = .GetByIndex(i)(0) & "金額"
For ii = 0 To .GetByIndex(i)(1).Count - 1
a(ii + 2, t - 1) = .GetByIndex(i)(1).GetKey(ii)
a(ii + 2, t) = .GetByIndex(i)(1).GetByIndex(ii)
Next
maxRow = Application.Max(maxRow, ii + 2)
Next
End With
With [n1].Resize(maxRow, UBound(a, 2))
.CurrentRegion.ClearContents
.Value = a
For ii = 1 To .Columns.Count Step 2
.Columns(ii).NumberFormat = "m月d日"
Next
.Columns.AutoFit
End With
End Sub
（seiya） 2019/07/04(木) 16:58
このマクロで実行したのですが、エラーが出てしまいます。
「実行時エラー"13" 型が一致しません」のようにエラーが出ます。
下記のところが、黄色のエラーがでます。
お教え頂けませんでしょうか。よろしくお願い致します。
.Item(a(i, 2))(1)(a(i, 1)) = .Item(a(i, 2))(1)(a(i, 1)) + a(i, 4)
行を増やした表です。
A B C D E F G H I J K L M N O P Q R S T U 1 日付 当該番号 品名 金額品名 番号 品名 日付 1りんご金額 日付 2ぶどう金額 日付 3バナナ金額 日付 4みかん金額 2 合計 1500 合計 500 合計 100 合計 500 合計 400 3 3月12日 2 ぶどう 100 1 りんご 4月16日 300 3月12日 100 5月13日 500 5月12日 400 4 4月16日 1 りんご 200 2 ぶどう 4月19日 200 5 4月19日 1 りんご 300 3 バナナ 6 5月12日 4 みかん 400 4 みかん 7 5月13日 3 バナナ 500
（令和２０） 2019/07/05(金) 09:20
>行とデータとの間に、集計などの行を改めて設けます。 この辺が分かりずらかったのですが、それでも動いているんですがね... まだどこか違うのかもしれませんが、とりあえず下記で試してください。
Sub test()
Dim a, i As Long, ii As Long, t As Long, maxRow As Long
a = Range("b2", Range("b" & Rows.Count).End(xlUp)).Resize(, 4).Value
With CreateObject("System.Collections.SortedList")
For i = 3 To UBound(a, 1)
If Not .Contains(a(i, 2)) Then
.Item(a(i, 2)) = Array(a(i, 2) & a(i, 3), _
CreateObject("System.Collections.SortedList"))
End If
.Item(a(i, 2))(1)(a(i, 1)) = .Item(a(i, 2))(1)(a(i, 1)) + a(i, 4)
Next
ReDim a(1 To UBound(a, 1), 1 To .Count * 2)
For i = 0 To .Count - 1
t = t + 2
a(1, t - 1) = "日付": a(1, t) = .GetByIndex(i)(0) & "金額"
a(2, t - 1) = "合計"
For ii = 0 To .GetByIndex(i)(1).Count - 1
a(ii + 3, t - 1) = .GetByIndex(i)(1).GetKey(ii)
a(ii + 3, t) = .GetByIndex(i)(1).GetByIndex(ii)
a(2, t) = a(2, t) + .GetByIndex(i)(1).GetByIndex(ii)
Next
maxRow = Application.Max(maxRow, ii + 2)
Next
End With
With [n1].Resize(maxRow, UBound(a, 2))
.CurrentRegion.ClearContents
.Value = a
For ii = 1 To .Columns.Count Step 2
.Columns(ii).NumberFormat = "m月d日"
Next
.Columns.AutoFit
End With
End Sub
（seiya） 2019/07/05(金) 09:57
>行とデータとの間に、集計などの行を改めて設けます。 すみません、理解しがたい表現ですね。改めて自分で読んでもおかしいと思いました。 これは、 >行を増やした表です。で示したとおり、２行目に１行増やすことを意味しています。 また、合計の所はsum関数で合計します。 １行増やさない状態のデータで、このひとつ前のマクロを実行するとうまくいきます。 しかし、１行増やした状態で、最新のマクロを実行すると、「実行時エラー -2147467261(800004003)」 キーをNullにすることができません。 パラメータ名:Key と出て実行できないのですが、どうでしようか。面倒をおかけしますが、お教え下さいませんでしようか。よろしくお願い致します。 （令和２０） 2019/07/05(金) 12:35
確認ですが
列はB:E, B1 = 日付, C1 = 当該番号, D1 = 品名, E1 = 金額品名
B2 = 空白, C2 = 空白, D2 = 合計, E2 = 1500 (合計)
データは3行目から
からではないのですか？ （seiya） 2019/07/05(金) 12:51
解りにくい作表で、すみません。多分。。。Ｃ列は全て空かと。。。 ご本人に聞かないと真実は解りませんが。。。m(_ _)m
（隠居じーさん） 2019/07/05(金) 12:55
（隠居じーさん）さん、ありがとうございます。
もしそうなら、これで
Sub test()
Dim a, i As Long, ii As Long, t As Long, maxRow As Long
a = Range("b3", Range("b" & Rows.Count).End(xlUp)).Resize(, 5).Value
With CreateObject("System.Collections.SortedList")
For i = 1 To UBound(a, 1)
If a(i, 3) <> "" Then
If Not .Contains(a(i, 3)) Then
.Item(a(i, 3)) = Array(a(i, 3) & a(i, 4), _
CreateObject("System.Collections.SortedList"))
End If
.Item(a(i, 3))(1)(a(i, 1)) = .Item(a(i, 3))(1)(a(i, 1)) + a(i, 5)
End If
Next
ReDim a(1 To UBound(a, 1), 1 To .Count * 2)
For i = 0 To .Count - 1
t = t + 2
a(1, t - 1) = "日付": a(1, t) = .GetByIndex(i)(0) & "金額"
a(2, t - 1) = "合計"
For ii = 0 To .GetByIndex(i)(1).Count - 1
a(ii + 3, t - 1) = .GetByIndex(i)(1).GetKey(ii)
a(ii + 3, t) = .GetByIndex(i)(1).GetByIndex(ii)
a(2, t) = a(2, t) + .GetByIndex(i)(1).GetByIndex(ii)
Next
maxRow = Application.Max(maxRow, ii + 2)
Next
End With
With [n1].Resize(maxRow, UBound(a, 2))
.CurrentRegion.ClearContents
.Value = a
For ii = 1 To .Columns.Count Step 2
.Columns(ii).NumberFormat = "m月d日"
Next
.Columns.AutoFit
End With
End Sub
（seiya） 2019/07/05(金) 13:25
C・G・H・K・L・M列は空白にしている理由は
公開では少しまずいので、空白にしています。
マクロに関わるデータではないと思いましたので
そのようにさせて頂いています。
>確認ですが >列はB:E, B1 = 日付, C1 = 当該番号, D1 = 品名, E1 = 金額品名 > B2 = 空白, C2 = 空白, D2 = 合計, E2 = 1500 (合計)
正しくは下記の通りです。
列はB:F, B1 = 日付, C1 = 空白, D1 = 当該番号, E1 = 品名 F1 = 金額品名
B2 = 空白, C2 = 空白, D2 = 空白, E2 = 合計 F1 = 1500 (合計)
>データは3行目から
データは3行目からです。
2行目は、合計などのためのsum関数などが入る行です。
（令和２０） 2019/07/05(金) 16:18
合計までできるようにして下さっていたとは感激です。凄いです。
誠に、ありがとうございました。
詳しく、やってはいませんが、私の思うようなことをして頂いたと思います。
今度も、驚かされました。ご協力に感謝・感謝です。重ねてお礼を申し上げま
す。
（隠居じーさん）さん、へのお礼も忘れるところでした。ありがとうございまし
た。
（令和２０） 2019/07/05(金) 16:40
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.