| |
▼kanabun さん：
>▼MARUMO さん：
>
>>SheetAの方は、型番が複数存在するイメージで
>>書いてしまってました。
>>今の所、同じ型番が複数行になる見込みだそうです。
>>（すみません。先程わかりました）
>
>> 1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
>> 2.SheetAの2行目から最終行までをSheetBの最終行+1
>> に貼り付け。
>
>この処理は
>
>1. SheetA の複製を作り（SheetA'とする）
>2. SheetBの型番を上から順に見ていって SheetA'になかったら、
> SheetA'の最終行+1行にコピーして追加。
>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。
>
>と同じことだと思うけど？
>そうなら、後者の方法のほうが作業量が少ない（行削除しない）ので
>効率的ですよね？
沢山のアドバイスありがとうございます。
データの持ち方、正しい処理を行ううえでは
おっしゃる通りなのですが、
今回のデータについては、少し特殊と言いますか・・・
ファイルを使っている方に確認をしたところ、
データは置き換えでいいとの事でしたので
あれから、なんとか下記までたどり着けました。
（↓シート名等は変更しております。）
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow As Long
Dim maxrow1 As Long
Dim maxrow2 As Long
Dim r As Long
Set ws1 = Sheets("db")'SheetB
Set ws2 = Sheets("wk")'SheetA
’同じ型番があれば削除
lastRow = ws1.Range("D" & Rows.Count).End(xlUp).Row
For r = lastRow To 2 Step -1
If WorksheetFunction.CountIf(ws2.Columns("D"), ws1.Range("D" & r)) > 0 Then
ws1.Rows(r).Delete
End If
Next
’SheetB(wk)へ追加処理
maxrow1 = ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
maxrow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
ws2.Select
Range(Cells(2, 1), Cells(maxrow2, 126)).Copy
ws1.Select
Range("A" & maxrow1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
|
|
MARUMO
- 14/8/18(月) 15:11 -
