回答編集履歴

2

処理が要件を満たしていなかったので修正

2023/01/20 00:14

投稿

pig_vba
pig_vba

スコア807

test CHANGED
@@ -13,8 +13,31 @@
13
13
  cells.specialCellsで可視セルだけ選択することも可能です。
14
14
 
15
15
  ```VBA
16
+ 'オートフィルタで区分データを抽出する
17
+
18
+ '(抽出する区分は2)
19
+
16
- wS1.Range("D1").CurrentRegion.Copy wS2.Range("A1")
20
+ wS1.Range("A1").AutoFilter Field:=1, Criteria1:="2"
21
+
22
+
23
+
17
-
24
+ 'オートフィルタで入力した日付を抽出する
25
+
26
+ wS1.Range("A1").AutoFilter Field:=2, Criteria1:=Format(d, strDateFormat)
27
+
28
+
29
+
30
+ '抽出した社員番号をコピーして貼り付ける
31
+
18
- wS1.Range("D1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS2.Range("A1")
32
+ wS1.Range(wS1.Cells(2,4),wS1.Cells(LastRow,4)).specialCells(xlCellTypeVisible).Copy Destination:=wS2.Range("A1")
33
+
34
+
35
+
36
+ Application.ScreenUpdating = True
37
+
38
+
39
+
40
+ End Sub
41
+
19
42
  ```
20
43
  ただし、こちらの手法はworksheet.ChangeイベントのトリガーになるらしいのでWorksheet.Changeイベントを使用している場合は使えません。

1

別解提示

2023/01/17 06:58

投稿

pig_vba
pig_vba

スコア807

test CHANGED
@@ -1,3 +1,4 @@
1
+ ### 一番手っ取り早い手法
1
2
  一列だけですよね?ちょっと見た目悪いですが手っ取り早く行うならこうでいいはずです。
2
3
  ```VBA
3
4
  wS1.Range("D1").CurrentRegion.Copy wS2.Range("A1")
@@ -6,6 +7,14 @@
6
7
  set rng= wS1.Range("D1").offset(1,0)'一セル下にずらす
7
8
  ws1.Range(rng,rng.end(xlDown)).Copy wS2.Range("A1")
8
9
  ```
9
- 手作業で見た時の操作としてはフィルター後にD1セルから一セル下~一番下のセルまで選択してコピーしてるのと同じ操作になります
10
+ 手作業で見た時の操作としてはフィルター後にD1セルから一セル下~一番下のセルまで選択してコピーしてるのと同じ操作になります
10
11
 
12
+ ### 別解
13
+ cells.specialCellsで可視セルだけ選択することも可能です。
11
14
 
15
+ ```VBA
16
+ wS1.Range("D1").CurrentRegion.Copy wS2.Range("A1")
17
+
18
+ wS1.Range("D1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy wS2.Range("A1")
19
+ ```
20
+ ただし、こちらの手法はworksheet.ChangeイベントのトリガーになるらしいのでWorksheet.Changeイベントを使用している場合は使えません。