teratail
回答率
85.48%
質問するログイン新規登録
トップVBAに関する質問フィルタされた内容を配列に入れてから配列の中身でOR条件にてソートしたい

編集履歴

回答編集履歴

4

コード内容を追記

2022/10/27 02:56

投稿

pig_vba
pig_vba

スコア807

test CHANGED
@@ -1,42 +1,36 @@
1
- 変数の型確認してないとか、定義不足とか、sheet指定してなくてactive変化したとき怖いとか突っ込みどころだらけですが、とりあえず形にだけします。
1
+ （1027編集）大ガバをやらかしました。BuffをRange型に定義変更してるからUbound使えるわけなかったです。デバッグなしで直書きはやはり横着過ぎてダメですね。反省
2
2
  ```Excel VBA
3
3
 
4
- '20221027 不具合の主原因が特定できないので暫定的に対応
5
-
6
4
  Sub 図番でのソート後配列に格納して再度フィルタ()
7
- Dim d as variant
5
+ Dim d As Variant
8
- Dim Buff As range
6
+ Dim Buff As Range
9
7
  'range型確定なので先に宣言
10
8
  Dim Cl As Range
11
- dim maxRow as Long
9
+ Dim maxRow As Long
12
10
 
13
- dim ws as worksheet:set ws=activesheet
11
+ Dim ws As Worksheet: Set ws = ActiveSheet
14
12
 
15
- ’ MaxRow = ws.Cells(ws.Rows.Count, 36).End(xlUp).offset(1,0).Row-1(最下行が非表示になってる可能性を考慮)
13
+ maxRow = ws.Cells(ws.Rows.Count, 36).End(xlUp).Offset(1, 0).Row - 1 '(最下行が非表示になってる可能性を考慮)
16
- ’ Set Buff = ws.Range("E2:E"& maxRow).SpecialCells(xlCellTypeVisible)
14
+ Set Buff = ws.Range("E1:E" & maxRow).SpecialCells(xlCellTypeVisible)
17
-
18
- Set Buff = ws.Range("E2:E50").SpecialCells(xlCellTypeVisible) '暫定的に変更。これで不具合の挙動がどう変わるか見たい
15
+
19
-
20
- dim k as long
16
+ Dim k As Long
21
- k=0
17
+ k = 0
22
- ReDim d(Ubound(Buff))
18
+ ReDim d(Buff.Cells.Count) 'BuffはRange型なのでセル数を取得
23
19
 
24
20
  For Each Cl In Buff
25
21
  'ClはRangeオブジェクトだからvalueだけ記憶
26
22
  d(k) = Cl.Value
27
23
  k = k + 1
28
-
29
- if k>99 then exit for
30
24
  Next
25
+
31
26
 
32
27
 
28
+ maxRow = ws.Cells(Rows.Count, 36).End(xlUp).Row
33
29
 
34
- MaxRow = ws.Cells(Rows.Count, 36).End(xlUp).Row
35
-
36
- ws.Range("A2:AS"& maxRow).AutoFilter 'フィルタ解除
30
+ ws.Range("A2:AS" & maxRow).AutoFilter 'フィルタ解除
37
31
 
38
32
 
39
- ws.Range(ws.Cells(1, 5), ws.Cells(MaxRow, 45)) _
33
+ ws.Range(ws.Cells(1, 5), ws.Cells(maxRow, 45)) _
40
34
  .AutoFilter Field:=1, _
41
35
  Criteria1:=d, _
42
36
  Operator:=xlFilterValues
@@ -44,4 +38,8 @@
44
38
 
45
39
  End Sub
46
40
 
41
+
47
42
  ```
43
+ 尚、d(0)にはタイトルの”部品コード”が格納されてしまいますが、余計なキーと空キーはデータ範囲に存在しない分には問題ないので意図的に無視してます（k=0のときだけ処理飛ばせばいいだけですが、それを書くとfor eachを使ってる意義がなくなりますので可読性が下がります）
44
+
45
+ これで要望通りの使用になってる…はず。勉強不足で追記だらけで申し訳ない

3

不具合報告を受けて暫定的に変更

2022/10/27 00:54

投稿

pig_vba
pig_vba

スコア807

test CHANGED
@@ -1,44 +1,47 @@
1
1
  変数の型確認してないとか、定義不足とか、sheet指定してなくてactive変化したとき怖いとか突っ込みどころだらけですが、とりあえず形にだけします。
2
2
  ```Excel VBA
3
3
 
4
+ '20221027 不具合の主原因が特定できないので暫定的に対応
5
+
4
6
  Sub 図番でのソート後配列に格納して再度フィルタ()
5
- Dim d(100) '配列の数←固定長にしてるのめっちゃ怖い
7
+ Dim d as variant
6
- Dim Buff As Variant
8
+ Dim Buff As range
7
9
  'range型確定なので先に宣言
8
10
  Dim Cl As Range
9
11
  dim maxRow as Long
12
+
13
+ dim ws as worksheet:set ws=activesheet
10
14
 
11
- Range("E1").CurrentRegion.Select
12
-
13
- '↓E列だけでよくない?あと48行目まで固定だと今後使い辛そう。最下行取って可変にしたほうがいいです
14
- MaxRow = Cells(Rows.Count, 36).End(xlUp).offset(1,0).Row-1(最下行が非表示になってる可能性を考慮)
15
+ ’ MaxRow = ws.Cells(ws.Rows.Count, 36).End(xlUp).offset(1,0).Row-1(最下行が非表示になってる可能性を考慮)
15
- Set Buff = Range("E2:E"& maxRow).SpecialCells(xlCellTypeVisible)
16
+ ’ Set Buff = ws.Range("E2:E"& maxRow).SpecialCells(xlCellTypeVisible)
16
17
 
17
- 'よくみたらk初期化してへんやんけ!!!!!!---------------------------------------------------
18
+ Set Buff = ws.Range("E2:E50").SpecialCells(xlCellTypeVisible) '暫定的に変更。これで不具合の挙動がどう変わるか見たい
19
+
18
20
  dim k as long
19
21
  k=0
20
- '-------------------------------------------------------------------------------------------
22
+ ReDim d(Ubound(Buff))
23
+
21
24
  For Each Cl In Buff
22
- 'E列しか取得してないからIf分も不要
23
- 'ClはRangeオブジェクトだからvalueだけ記憶
25
+ 'ClはRangeオブジェクトだからvalueだけ記憶
24
- d(k) = Cl.Value
26
+ d(k) = Cl.Value
25
- k = k + 1
27
+ k = k + 1
26
- 'やっぱ怖いから条件追加しとこ
28
+
27
- if k>99 then exit for
29
+ if k>99 then exit for
28
30
  Next
29
31
 
30
- Range("A2:AS"& maxRow).AutoFilter 'フィルタ解除
31
32
 
32
- '上記の設定方法なら再設定しなくてもいいけど一応
33
+
33
- MaxRow = Cells(Rows.Count, 36).End(xlUp).Row
34
+ MaxRow = ws.Cells(Rows.Count, 36).End(xlUp).Row
35
+
36
+ ws.Range("A2:AS"& maxRow).AutoFilter 'フィルタ解除
34
37
 
35
- 'キーはClじゃなくてd()ですよ
38
+
36
- Range(Cells(1, 5), Cells(MaxRow, 45)) _
39
+ ws.Range(ws.Cells(1, 5), ws.Cells(MaxRow, 45)) _
37
40
  .AutoFilter Field:=1, _
38
41
  Criteria1:=d, _
39
42
  Operator:=xlFilterValues
40
43
 
41
- 'Criteria1:=array(...)と同じ
44
+
42
45
  End Sub
43
46
 
44
47
  ```

2

よくみたら変数kについて何も書かれてなかったので修正

2022/10/26 07:40

投稿

pig_vba
pig_vba

スコア807

test CHANGED
@@ -13,12 +13,18 @@
13
13
  '↓E列だけでよくない?あと48行目まで固定だと今後使い辛そう。最下行取って可変にしたほうがいいです
14
14
  MaxRow = Cells(Rows.Count, 36).End(xlUp).offset(1,0).Row-1(最下行が非表示になってる可能性を考慮)
15
15
  Set Buff = Range("E2:E"& maxRow).SpecialCells(xlCellTypeVisible)
16
+
17
+ 'よくみたらk初期化してへんやんけ!!!!!!---------------------------------------------------
18
+ dim k as long
19
+ k=0
20
+ '-------------------------------------------------------------------------------------------
16
21
  For Each Cl In Buff
17
22
  'E列しか取得してないからIf分も不要
18
23
  'ClはRangeオブジェクトだからvalueだけ記憶
19
24
  d(k) = Cl.Value
20
25
  k = k + 1
21
-
26
+ 'やっぱ怖いから条件追加しとこ
27
+ if k>99 then exit for
22
28
  Next
23
29
 
24
30
  Range("A2:AS"& maxRow).AutoFilter 'フィルタ解除

1

filter範囲を可変にしました。

2022/10/26 06:16

投稿

pig_vba
pig_vba

スコア807

test CHANGED
@@ -6,11 +6,13 @@
6
6
  Dim Buff As Variant
7
7
  'range型確定なので先に宣言
8
8
  Dim Cl As Range
9
-
9
+ dim maxRow as Long
10
+
10
11
  Range("E1").CurrentRegion.Select
11
12
 
12
- '↓E列だけでよくない?あと48行目まで固定だと今後使い辛そう。maxRow取って可変にしたほうがいいです
13
+ '↓E列だけでよくない?あと48行目まで固定だと今後使い辛そう。最下行取って可変にしたほうがいいです
14
+ MaxRow = Cells(Rows.Count, 36).End(xlUp).offset(1,0).Row-1(最下行が非表示になってる可能性を考慮)
13
- Set Buff = Range("E2:E48").SpecialCells(xlCellTypeVisible)
15
+ Set Buff = Range("E2:E"& maxRow).SpecialCells(xlCellTypeVisible)
14
16
  For Each Cl In Buff
15
17
  'E列しか取得してないからIf分も不要
16
18
  'ClはRangeオブジェクトだからvalueだけ記憶
@@ -19,10 +21,9 @@
19
21
 
20
22
  Next
21
23
 
22
- Range("A2:AS48").AutoFilter 'フィルタ解除
24
+ Range("A2:AS"& maxRow).AutoFilter 'フィルタ解除
23
25
 
24
- Dim MaxRow As Long
26
+ '上記の設定方法なら再設定しなくてもいいけど一応
25
-
26
27
  MaxRow = Cells(Rows.Count, 36).End(xlUp).Row
27
28
 
28
29
  'キーはClじゃなくてd()ですよ