teratail
回答率
85.36%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問セルの検索について（ＶＢＡ）

編集履歴

回答編集履歴

3

コード修正

2019/09/22 07:35

投稿

hatena19
hatena19

スコア34073

test CHANGED
@@ -34,26 +34,50 @@
34
34
 
35
35
  Dim d As Double
36
36
 
37
- d = #2019/1/2#
37
+ d = #1/6/2019#
38
38
 
39
39
 
40
40
 
41
- Dim r1 As Long, r2 As Long
41
+ Dim r1, r2
42
42
 
43
- r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
43
+ r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
44
44
 
45
- Select Case True
46
45
 
46
+
47
- Case IsError(r1), ActiveSheet.Cells(r1, 2) < d
47
+ If IsError(r2) Then 'd以前のデータなし
48
48
 
49
49
  MsgBox CDate(d) & "のデータはありません。"
50
50
 
51
- Case Else
51
+ Else
52
52
 
53
- r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
53
+ r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
54
54
 
55
- MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
55
+ If DateValue(ActiveSheet.Cells(r2, 2)) < d Then
56
56
 
57
+ MsgBox CDate(d) & "のデータはありません。"
58
+
59
+ Else
60
+
61
+ If IsError(r1) Then
62
+
63
+ r1 = 1
64
+
65
+ ElseIf ActiveSheet.Cells(r1, 2) < d Then
66
+
67
+ r1 = r1 + 1
68
+
57
- End Select
69
+ End If
70
+
71
+ MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
72
+
73
+ End If
74
+
75
+ End If
58
76
 
59
77
  ```
78
+
79
+
80
+
81
+ 想像以上に難しかったです。
82
+
83
+ もっと、いい方法がありそうな気がします(;^ω^)，

2

コード修正

2019/09/22 07:35

投稿

hatena19
hatena19

スコア34073

test CHANGED
@@ -42,16 +42,18 @@
42
42
 
43
43
  r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
44
44
 
45
+ Select Case True
46
+
45
- If IsError(r1) Or ActiveSheet.Cells(r1, 2) < d Then
47
+ Case IsError(r1), ActiveSheet.Cells(r1, 2) < d
46
48
 
47
49
  MsgBox CDate(d) & "のデータはありません。"
48
50
 
49
- Else
51
+ Case Else
50
52
 
51
53
  r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
52
54
 
53
55
  MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
54
56
 
55
- End If
57
+ End Select
56
58
 
57
59
  ```

1

コード追加

2019/09/22 06:49

投稿

hatena19
hatena19

スコア34073

test CHANGED
@@ -22,6 +22,36 @@
22
22
 
23
23
  MsgBox CDate(d) & "のデータは" & r1 & "行目から" & r2 & "行目まで"
24
24
 
25
+ ```
25
26
 
26
27
 
28
+
29
+ 該当日付のデータがない場合も考慮すると下記のコードで。
30
+
31
+
32
+
33
+ ```vba
34
+
35
+ Dim d As Double
36
+
37
+ d = #2019/1/2#
38
+
39
+
40
+
41
+ Dim r1 As Long, r2 As Long
42
+
43
+ r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
44
+
45
+ If IsError(r1) Or ActiveSheet.Cells(r1, 2) < d Then
46
+
47
+ MsgBox CDate(d) & "のデータはありません。"
48
+
49
+ Else
50
+
51
+ r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
52
+
53
+ MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
54
+
55
+ End If
56
+
27
57
  ```