回答編集履歴

1

参考

2025/04/09 02:29

投稿

yambejp
yambejp

スコア117561

test CHANGED
@@ -6,3 +6,54 @@
6
6
  0. 各シートのデータをindex+matchで抽出
7
7
 
8
8
  という流れになると思います
9
+
10
+
11
+ # 参考
12
+
13
+ 復数のシートのA列の値を「シートA」のA列に集約する方法
14
+ ```vba
15
+ Dim r1 As Range
16
+ Dim r2 As Range
17
+ Dim sheet As Worksheet
18
+ Dim shukeiSheetName As String
19
+ shukeiSheetName = "シートA"
20
+
21
+ Dim allData() As Variant
22
+ Dim uniqueData As Variant
23
+ Dim newData() As Variant
24
+ Dim dict As Object
25
+ Set dict = CreateObject("Scripting.Dictionary")
26
+ For Each sheet In Sheets
27
+ Set r1 = sheet.Range("A:A")
28
+ If sheet.name <> shukeiSheetName Then
29
+ If WorksheetFunction.CountIf(r1, "<>") > 0 Then
30
+ Set r2 = r1.SpecialCells(xlCellTypeConstants)
31
+ For Each cell In r2
32
+ If Not IsEmpty(cell.Value) Then
33
+ If (Not Not allData) = 0 Then
34
+ n = 0
35
+ Else
36
+ n = UBound(allData) + 1
37
+ End If
38
+ ReDim Preserve allData(n)
39
+ allData(n) = cell.Value
40
+ End If
41
+ Next
42
+ End If
43
+ End If
44
+ Next
45
+ For i = 0 To UBound(allData)
46
+ If Not dict.exists(allData(i)) Then
47
+ dict.Add allData(i), True
48
+ End If
49
+ Next i
50
+ uniqueData = dict.keys
51
+ ReDim newData(UBound(uniqueData), 0)
52
+ For i = 0 To UBound(uniqueData)
53
+ newData(i, 0) = uniqueData(i)
54
+ Next i
55
+ Set sheet = Sheets(shukeiSheetName)
56
+ If Not sheet Is Nothing Then
57
+ sheet.Range(sheet.Cells(1, 1), sheet.Cells(UBound(uniqueData) + 1, 1)).Value = newData
58
+ End If
59
+ ```