回答編集履歴

2

Sheet1の日付のみを取得するように変えました。(時分秒は無視します)

2022/12/07 01:51

投稿

tatsu99
tatsu99

スコア5438

test CHANGED
@@ -1,4 +1,6 @@
1
+ Sheet1の日付のみを取得するように変えました。(時分秒は無視します)
1
- 全面的に作変えました。
2
+ 及び下記のコーディング誤を修正しました。
3
+ For row1 = 2 To maxrow2 -> For row1 = 2 To maxrow1
2
4
  ```VBA
3
5
  Public Sub 注文番号及び日付チェック()
4
6
  Dim dicT As Object 'キー:注文番号+日付 値:Sheet2の行番号
@@ -9,6 +11,7 @@
9
11
  Dim sh2 As Worksheet 'Sheet2
10
12
  Dim row1 As Long
11
13
  Dim row2 As Long
14
+ Dim wdate As Date
12
15
  Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
13
16
  Set sh1 = Worksheets("sheet1")
14
17
  Set sh2 = Worksheets("sheet2")
@@ -21,8 +24,9 @@
21
24
  dicT(key) = row2
22
25
  Next
23
26
  'Sheet1を処理する
24
- For row1 = 2 To maxrow2
27
+ For row1 = 2 To maxrow1
28
+ wdate = Int(sh1.Cells(row1, "Q").Value)
25
- key = sh1.Cells(row1, "E").Value & "|" & sh1.Cells(row1, "Q").Value
29
+ key = sh1.Cells(row1, "E").Value & "|" & wdate
26
30
  '注文番号+日付がSheet2にも存在するなら赤色背景を設定
27
31
  If dicT.exists(key) = True Then
28
32
  sh1.Cells(row1, "E").Interior.Color = RGB(255, 0, 0)
@@ -30,5 +34,4 @@
30
34
  Next
31
35
  MsgBox ("完了")
32
36
  End Sub
33
-
34
37
  ```

1

全面的に作り変えました。

2022/12/05 04:57

投稿

tatsu99
tatsu99

スコア5438

test CHANGED
@@ -1,19 +1,34 @@
1
- 修正しました。
1
+ 全面的に作り変えました。
2
2
  ```VBA
3
- Sub 日付が一致しているかチェック()
3
+ Public Sub 注文番号及び日付チェック()
4
+ Dim dicT As Object 'キー:注文番号+日付 値:Sheet2の行番号
5
+ Dim maxrow1 As Long 'Sheet1 最終行
6
+ Dim maxrow2 As Long 'Sheet2 最終行
7
+ Dim key As String
8
+ Dim sh1 As Worksheet 'Sheet1
9
+ Dim sh2 As Worksheet 'Sheet2
4
- Dim x As Long
10
+ Dim row1 As Long
5
- Dim i As Long
11
+ Dim row2 As Long
6
- Dim r As Range
12
+ Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
7
- With Sheets("Sheet1")
13
+ Set sh1 = Worksheets("sheet1")
14
+ Set sh2 = Worksheets("sheet2")
8
- x = .Cells(Rows.Count, "E").End(xlUp).Row
15
+ maxrow1 = sh1.Cells(Rows.Count, "E").End(xlUp).Row 'Sheet1 E列 最終行を求める
16
+ maxrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row 'Sheet2 A列 最終行を求める
9
- .Range("E2:E" & x).Interior.Pattern = xlNone
17
+ sh1.Range("E2:E" & maxrow1).Interior.Pattern = xlNone
18
+ 'Sheet2の注文番号+日付を記憶
10
- For i = 2 To x
19
+ For row2 = 2 To maxrow2
20
+ key = sh2.Cells(row2, "A").Value & "|" & sh2.Cells(row2, "E").Value
21
+ dicT(key) = row2
22
+ Next
23
+ 'Sheet1を処理する
24
+ For row1 = 2 To maxrow2
11
- Set r = Sheets("Sheet2").Range("E:E").Find(What:=.Cells(i, 17), LookAt:=xlWhole)
25
+ key = sh1.Cells(row1, "E").Value & "|" & sh1.Cells(row1, "Q").Value
26
+ '注文番号+日付がSheet2にも存在するなら赤色背景を設定
12
- If Not r Is Nothing Then
27
+ If dicT.exists(key) = True Then
13
- .Cells(i, 5).Interior.Color = RGB(255, 0, 0)
28
+ sh1.Cells(row1, "E").Interior.Color = RGB(255, 0, 0)
14
- End If
29
+ End If
15
- Next i
30
+ Next
16
- End With
31
+ MsgBox ("完了")
17
32
  End Sub
18
33
 
19
34
  ```