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

回答編集履歴

1

コード追記

2019/08/28 02:02

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -4,4 +4,40 @@
4
4
 
5
5
  [Office TANAKA - Excel VBA Tips[オートフィルタ[作業列で絞り込む]]](http://officetanaka.net/excel/vba/tips/tips193.htm)
6
6
 
7
- [複雑な条件(複数除外等)のオートフィルター(AutoFilter)|VBA技術解説](https://excel-ubara.com/excelvba4/EXCEL259.html)
7
+ [複雑な条件(複数除外等)のオートフィルター(AutoFilter)|VBA技術解説](https://excel-ubara.com/excelvba4/EXCEL259.html)
8
+
9
+ 追記
10
+ ---
11
+ > フィルタにかけた後、抽出された項目の氏名をコピーして別シートに貼り付けるものです。
12
+
13
+ フィルターは手段で最終目的が該当する氏名のコピーなら、
14
+ オートフィルターは使わずに、
15
+ VBAで該当する氏名を配列に格納して、
16
+ それを出力先に代入すればシンプルになるでしょう。
17
+
18
+ コード例
19
+ ```vba
20
+ Sub NameCopy()
21
+ Dim ws01 As Worksheet: Set ws01 = Sheet1
22
+ Dim ws02 As Worksheet: Set ws02 = Sheet2
23
+ Dim col_Num As Long: col_Num = ws02.Range("A1")
24
+ Dim val As String: val = ws02.Range("A2")
25
+ Dim maxRow As Long: maxRow = ws01.Cells(1, 1).End(xlDown).Row
26
+ '該当する名前の格納用配列(最大数分確保しておく)
27
+ Dim aryName() As String: ReDim aryName(maxRow - 2)
28
+
29
+ Dim i As Long, cnt As Long
30
+ For i = 2 To maxRow
31
+ With ws01.Cells(i, col_Num)
32
+ If .Interior.Color = vbYellow And .Value = val Then
33
+ aryName(cnt) = ws01.Cells(i, 1)
34
+ cnt = cnt + 1
35
+ End If
36
+ End With
37
+ Next
38
+ ws02.Range("B:B").ClearContents
39
+ '名前配列を縦横変換して代入、代入するセル範囲のサイズを該当件数で制限しておく
40
+ ws02.Range("B1").Resize(cnt).Value = WorksheetFunction.Transpose(aryName)
41
+ End Sub
42
+
43
+ ```