回答編集履歴

2

追記

2021/06/02 12:13

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -41,3 +41,59 @@
41
41
 
42
42
 
43
43
  ```
44
+
45
+
46
+
47
+ ---
48
+
49
+ ```VBA
50
+
51
+ Dim sPath
52
+
53
+ sPath = "C:\webb\Total.xlsx"
54
+
55
+
56
+
57
+ Dim wb As Workbook
58
+
59
+ Set wb = Workbooks.Open(Filename:=sPath, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
60
+
61
+
62
+
63
+ Dim ws As Worksheet
64
+
65
+ Set ws = wb.Worksheets(1)
66
+
67
+
68
+
69
+ Dim myList As Variant
70
+
71
+ myList = ws.Range("A2", ws.Range("A" & ws.Rows.Count).End(xlUp)).Resize(, 2).Value
72
+
73
+ wb.Close SaveChanges:=False
74
+
75
+
76
+
77
+ Dim myDic 'As Scripting.Dictionary
78
+
79
+ Set myDic = CreateObject("Scripting.Dictionary")
80
+
81
+
82
+
83
+ Dim i As Long
84
+
85
+ For i = 1 To UBound(myList, 1)
86
+
87
+ myDic(myList(i, 1)) = myDic(myList(i, 1)) + myList(i, 2)
88
+
89
+ Next
90
+
91
+ If myDic.Exists(Empty) Then myDic.Remove Empty
92
+
93
+
94
+
95
+ ws.Range("E2").Resize(myDic.Count, 2).Value = WorksheetFunction.Transpose(Array(myDic.Keys, myDic.Items))
96
+
97
+
98
+
99
+ ```

1

修正

2021/06/02 12:13

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -26,11 +26,15 @@
26
26
 
27
27
  'リストを出力
28
28
 
29
+ Dim outSheet As Worksheet
30
+
31
+ Set outSheet = Thisworkbook.Worksheets(1)
32
+
29
33
  For i = 0 To UBound(myKey)
30
34
 
31
- ws.Cells(i + 2, 5).Value = myKey(i)
35
+ outSheet.Cells(i + 2, 5).Value = myKey(i)
32
36
 
33
- ws.Cells(i + 2, 6).Value = myItem(i)
37
+ outSheet.Cells(i + 2, 6).Value = myItem(i)
34
38
 
35
39
  Next
36
40