回答編集履歴
1
参考
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
|
+
```
|