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

編集履歴

回答編集履歴

3

コード修正

2019/09/22 07:35

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -16,15 +16,27 @@
16
16
 
17
17
  ```vba
18
18
  Dim d As Double
19
- d = #2019/1/2#
19
+ d = #1/6/2019#
20
20
 
21
- Dim r1 As Long, r2 As Long
21
+ Dim r1, r2
22
- r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
22
+ r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
23
- Select Case True
23
+
24
- Case IsError(r1), ActiveSheet.Cells(r1, 2) < d
24
+ If IsError(r2) Then 'd以前のデータなし
25
25
  MsgBox CDate(d) & "のデータはありません。"
26
- Case Else
26
+ Else
27
- r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
27
+ r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
28
+ If DateValue(ActiveSheet.Cells(r2, 2)) < d Then
29
+ MsgBox CDate(d) & "のデータはありません。"
30
+ Else
31
+ If IsError(r1) Then
32
+ r1 = 1
33
+ ElseIf ActiveSheet.Cells(r1, 2) < d Then
34
+ r1 = r1 + 1
35
+ End If
28
- MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
36
+ MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
29
- End Select
37
+ End If
38
+ End If
30
- ```
39
+ ```
40
+
41
+ 想像以上に難しかったです。
42
+ もっと、いい方法がありそうな気がします(;^ω^)，

2

コード修正

2019/09/22 07:35

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -20,10 +20,11 @@
20
20
 
21
21
  Dim r1 As Long, r2 As Long
22
22
  r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
23
+ Select Case True
23
- If IsError(r1) Or ActiveSheet.Cells(r1, 2) < d Then
24
+ Case IsError(r1), ActiveSheet.Cells(r1, 2) < d
24
25
  MsgBox CDate(d) & "のデータはありません。"
25
- Else
26
+ Case Else
26
27
  r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
27
28
  MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
28
- End If
29
+ End Select
29
30
  ```

1

コード追加

2019/09/22 06:49

投稿

hatena19
hatena19

スコア34367

answer CHANGED
@@ -10,5 +10,20 @@
10
10
  r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
11
11
  r2 = Application.Match(d + CDbl(#23:59:59#), ActiveSheet.Range("B:B"), 1)
12
12
  MsgBox CDate(d) & "のデータは" & r1 & "行目から" & r2 & "行目まで"
13
+ ```
13
14
 
15
+ 該当日付のデータがない場合も考慮すると下記のコードで。
16
+
17
+ ```vba
18
+ Dim d As Double
19
+ d = #2019/1/2#
20
+
21
+ Dim r1 As Long, r2 As Long
22
+ r1 = Application.Match(d, ActiveSheet.Range("B:B"), 1)
23
+ If IsError(r1) Or ActiveSheet.Cells(r1, 2) < d Then
24
+ MsgBox CDate(d) & "のデータはありません。"
25
+ Else
26
+ r2 = Application.Match(d + CDbl(#11:59:59 PM#), ActiveSheet.Range("B:B"), 1)
27
+ MsgBox CDate(d) & "は" & r1 & "行目から" & r2 & "行目まで"
28
+ End If
14
29
  ```