| |
かおピ さん、おはようございます。
>>このようにsheet1の訂正１と訂正２に上記のような数字が入ったら
>>sheet2の受１．受２．受３へ数字を転記したいです。
>>ただし、・・・＊のようにsheet1の訂正１に数字が入らず訂正２に１が入っても
>>転記はしない。（基準は、訂正１にあります。）
>>sheet2の訂正日は、当日の日付（５/３１）を転記したいです。
>>よろしくお願いします。
ベタに転記していくなら。
Option Explicit
Sub test()
Dim ws(1 To 2) As Worksheet
Dim RR As Long, Rpos As Long, Rmax As Long, CC As Integer
With Application.ThisWorkbook
Set ws(1) = .Worksheets("Sheet1") '元
Set ws(2) = .Worksheets("Sheet2") '先
End With
'
Rmax = ws(1).Range("A65536").End(xlUp).Row
Rpos = ws(2).Range("A65536").End(xlUp).Row
'表は２行目から開始
For RR = 2 To Rmax
With ws(1)
'訂正1に1が入っている場合、訂正２に何が入っているかで分岐
Select Case .Cells(RR, 4).Value
Case 1: If .Cells(RR, 5).Value = 1 Then CC% = 3 Else CC% = 1
Case 2: CC% = 2
Case Else: CC% = 0
End Select
'転記先の列位置(CC%)が０以外の時に転記する
If CC% = 0 Then
.Rows(RR).Interior.ColorIndex = 38
Else
Rpos = Rpos + 1
ws(2).Cells(Rpos, 1).Value = Date
ws(2).Cells(Rpos, 2).Value = .Cells(RR, 1).Value
ws(2).Cells(Rpos, 2 + CC%).Value = .Cells(RR, 2).Value 'CDE
ws(2).Cells(Rpos, 6).Value = .Cells(RR, 3).Value
End If
End With
Next
Erase ws
End Sub
こんな感じです。
動作チェックのために、転記しなかった行に色を塗っています。
なお、処理対象のデータ件数がものすごく多い場合は、配列に入れた方が転記の処理は格段に速くなります。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/6/3(日) 9:00 -
