| |
▼まるばつ さん：
改訂版です。
Sub Sample()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Dim i As Long
Dim mx As Long
Dim k As String
Dim z As Variant
Dim n1 As Long
Dim n2 As Long
Dim r As Range
Application.ScreenUpdating = False
Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
Set sh3 = Sheets("Sheet3")
mx = sh1.Range("A" & Rows.Count).End(xlUp).Row 'Sheet1 の最終セルの行番号
For i = 2 To mx '２行目から最終行までを繰り返し処理
k = sh1.Cells(i, "C").Value 'その行のC列の値
If Not IsEmpty(k) Then '空白の値でなければ
Set r = sh2.Range("C1", sh2.Range("C" & Rows.Count).End(xlUp))
z = Application.Match(k, r, 0) 'その値がSHeet2のC列にあるかどうか
If IsNumeric(z) Then 'あった
sh1.Cells(i, "D").Value = sh1.Cells(i, "D").Value - sh2.Cells(z, "D").Value 'D列のセル Sheet1-Sheet2
sh1.Cells(i, "E").Value = sh1.Cells(i, "E").Value - sh2.Cells(z, "E").Value 'E列のセル Sheet1-Sheet2
sh1.Rows(i).Copy sh3.Range("A" & Rows.Count).End(xlUp).Offset(1) 'この時点のSheet3の最終行の次の行に追加
sh1.Rows(i).ClearContents 'Sheet1の該当行をクリア
sh2.Rows(z).ClearContents 'SHeet2の該当行をクリア
End If
End If
Next
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
