| |
素人 さん、こんにちわ。
>２つのシートのそれぞれＡ列の文字を照合して同じ場合は、片方のシート1のＩ列からデータのある最終列までＣＯＰＹしてもうひとつのシート2に貼り付けしたいです
>同じ文字がない場合は、シート２のA列の最終行にシート１のその値を貼り付けたいです誰かわかる方アドバイスお願いいたします。
ワークシート関数を使ってチェックをかけてます。
Sub test()
Dim ws(1 To 2) As Worksheet
Dim Rmax As Long, Cmax As Long, RR As Long, Rpos As Long
Set ws(1) = ThisWorkbook.Worksheets("Sheet1")
Set ws(2) = ThisWorkbook.Worksheets("Sheet2")
'
With ws(1)
With .UsedRange
Rmax = .Cells(.Count).Row
Cmax = .Cells(.Count).Column
End With
For RR = 1 To Rmax
'空白以外を処理
If .Cells(RR, 1).Value <> "" Then
'ワークシート関数を活用
If Application.WorksheetFunction. _
CountIf(ws(2).Columns(1), .Cells(RR, 1).Value) = 0 Then
'なかったら下にコピペ（５行あけなくていいのかな？）
With ws(2)
Rpos = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
ws(1).Rows(RR).Copy Destination:=.Cells(Rpos, 1) '行単位で貼り付け
End With
Else
Rpos = Application.WorksheetFunction. _
Match(.Cells(RR, 1).Value, ws(2).Columns(1), 0)
'コピペする
.Range(.Cells(RR, 9), .Cells(RR, Cmax)).Copy Destination:=ws(2).Cells(Rpos, 9)
End If
End If
Next
End With
'
Erase ws
End Sub
こんな感じです。
書式が行って欲しくない時は、PasteSpecialメソッドを使用して貼りつけるようにします。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/11/28(水) 11:28 -
