teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

追記

2021/06/28 10:54

投稿

jinoji
jinoji

スコア4592

answer CHANGED
@@ -7,4 +7,57 @@
7
7
  |課長)田中|||課長)今野|メンバー)秋元||
8
8
  ||||
9
9
  ||||
10
- ||||
10
+ ||||
11
+
12
+ ---
13
+ <追記>
14
+ 多分こんな感じだと思う。
15
+ ```vba
16
+ Sub 課検索()
17
+
18
+ Dim SearchRange As Range '検索範囲格納
19
+ Dim ResultRange As Range '検索結果格納
20
+ Dim StartRange As Range '検索行格納
21
+ Dim KeyItem As String
22
+ Dim MsgStr As String
23
+ Dim i As Long
24
+
25
+
26
+ Set SearchRange = Worksheets("組織図").Range("A:Z") '検索したいデータ範囲
27
+
28
+ KeyItem = "*課"
29
+ Set ResultRange = SearchRange.Find(What:=KeyItem, Lookat:=xlWhole)
30
+ If ResultRange Is Nothing Then Exit Sub
31
+ Set StartRange = ResultRange '最初に見つかったセルを格納しておく
32
+
33
+
34
+ Dim ws As Worksheet, outRange As Range
35
+ Set ws = Worksheets("Sheet1")
36
+ Set outRange = ws.Cells(ws.Rows.Count, 1).End(xlUp).Offset(1, 0)
37
+
38
+
39
+ Do
40
+ Dim kacho As Range, member As Range
41
+ Set kacho = ResultRange.Offset(1, 0)
42
+ Set member = ResultRange.Offset(0, 1)
43
+ i = 0
44
+
45
+ outRange.Value = kacho.Value
46
+ If member.Value = "" Then
47
+ Set outRange = outRange.Offset(1, 0)
48
+ Else
49
+ Do While member.Offset(i, 0).Value <> ""
50
+ outRange.Offset(i, 1).Value = member.Offset(i, 0).Value
51
+ i = i + 1
52
+ Loop
53
+ Set outRange = outRange.Offset(i, 0)
54
+ End If
55
+
56
+ Set ResultRange = SearchRange.FindNext(After:=ResultRange) '次の検索セルを指定する
57
+
58
+ If ResultRange.Address = StartRange.Address Then Exit Do '見つかったセルが最初のセルか判定 同じ場合はループを離脱
59
+
60
+ Loop
61
+
62
+ End Sub
63
+ ```