回答編集履歴

1

追記

2021/06/28 10:54

投稿

jinoji
jinoji

スコア4592

test CHANGED
@@ -17,3 +17,109 @@
17
17
  ||||
18
18
 
19
19
  ||||
20
+
21
+
22
+
23
+ ---
24
+
25
+ <追記>
26
+
27
+ 多分こんな感じだと思う。
28
+
29
+ ```vba
30
+
31
+ Sub 課検索()
32
+
33
+
34
+
35
+ Dim SearchRange As Range '検索範囲格納
36
+
37
+ Dim ResultRange As Range '検索結果格納
38
+
39
+ Dim StartRange As Range '検索行格納
40
+
41
+ Dim KeyItem As String
42
+
43
+ Dim MsgStr As String
44
+
45
+ Dim i As Long
46
+
47
+
48
+
49
+
50
+
51
+ Set SearchRange = Worksheets("組織図").Range("A:Z") '検索したいデータ範囲
52
+
53
+
54
+
55
+ KeyItem = "*課"
56
+
57
+ Set ResultRange = SearchRange.Find(What:=KeyItem, Lookat:=xlWhole)
58
+
59
+ If ResultRange Is Nothing Then Exit Sub
60
+
61
+ Set StartRange = ResultRange '最初に見つかったセルを格納しておく
62
+
63
+
64
+
65
+
66
+
67
+ Dim ws As Worksheet, outRange As Range
68
+
69
+ Set ws = Worksheets("Sheet1")
70
+
71
+ Set outRange = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0)
72
+
73
+
74
+
75
+
76
+
77
+ Do
78
+
79
+ Dim kacho As Range, member As Range
80
+
81
+ Set kacho = ResultRange.Offset(1, 0)
82
+
83
+ Set member = ResultRange.Offset(0, 1)
84
+
85
+ i = 0
86
+
87
+
88
+
89
+ outRange.Value = kacho.Value
90
+
91
+ If member.Value = "" Then
92
+
93
+ Set outRange = outRange.Offset(1, 0)
94
+
95
+ Else
96
+
97
+ Do While member.Offset(i, 0).Value <> ""
98
+
99
+ outRange.Offset(i, 1).Value = member.Offset(i, 0).Value
100
+
101
+ i = i + 1
102
+
103
+ Loop
104
+
105
+ Set outRange = outRange.Offset(i, 0)
106
+
107
+ End If
108
+
109
+
110
+
111
+ Set ResultRange = SearchRange.FindNext(After:=ResultRange) '次の検索セルを指定する
112
+
113
+
114
+
115
+ If ResultRange.Address = StartRange.Address Then Exit Do '見つかったセルが最初のセルか判定 同じ場合はループを離脱
116
+
117
+
118
+
119
+ Loop
120
+
121
+
122
+
123
+ End Sub
124
+
125
+ ```