Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1155 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【75995】別シートの値と比較し、削除、追加を行いたい MARUMO 14/8/17(日) 22:20 質問[未読]
【75996】Re:別シートの値と比較し、削除、追加を行... カエムワセト 14/8/17(日) 22:33 発言[未読]
【75997】Re:別シートの値と比較し、削除、追加を行... MARUMO 14/8/18(月) 9:30 発言[未読]
【75998】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 9:40 発言[未読]
【75999】Re:別シートの値と比較し、削除、追加を行... MARUMO 14/8/18(月) 10:23 発言[未読]
【76000】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 10:29 発言[未読]
【76001】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 10:32 発言[未読]
【76002】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 10:34 発言[未読]
【76005】Re:別シートの値と比較し、削除、追加を行... MARUMO 14/8/18(月) 11:28 発言[未読]
【76006】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 11:55 発言[未読]
【76003】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 10:49 発言[未読]
【76004】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 11:02 発言[未読]
【76007】Re:別シートの値と比較し、削除、追加を行... MARUMO 14/8/18(月) 11:56 発言[未読]
【76008】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 12:20 発言[未読]
【76009】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 14:44 発言[未読]
【76010】Re:別シートの値と比較し、削除、追加を行... MARUMO 14/8/18(月) 15:11 発言[未読]
【76011】Re:別シートの値と比較し、削除、追加を行... MARUMO 14/8/18(月) 16:09 お礼[未読]
【76012】Re:別シートの値と比較し、削除、追加を行... kanabun 14/8/18(月) 18:59 発言[未読]
【76013】Re:別シートの値と比較し、削除、追加を行... MARUMO 14/8/18(月) 21:59 お礼[未読]
【75995】別シートの値と比較し、削除、追加を行い...
質問  MARUMO  - 14/8/17(日) 22:20 -
引用なし
パスワード
   VBA 初心者です。
宜しくお願いします。
シートA,B(同一ファイル内)があり、Bは管理データ。
日々発生するAの情報をBへ反映(更新)したい。
A,Bは同じ項目でA列からZ列まであります。（数値、文字、日付含む）
A,B双方のA列の型番を比較し(A列の最終行まで)、
Bに同じ型番が存在すれば、
Bの全て対象行を削除し、Aの対象型番をBへコピーしたい。

管理台帳.xlsm
【SheetA】
A列 　B列 C列 D列 E列 F列 ・・・Z列
型番1 7　 7　 7　 7　 7　 ・・・2014/08/01
型番2 5　 5　 5　 5　 5　 ・・・2014/08/05
型番3 8　 8　 8　 8　 8　 ・・・2014/07/01
型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　
型番5 4　 4　 4　 4　 4　 ・・・2014/08/15　　

【SheetB】更新前
A列 　B列 C列 D列 E列 F列 ・・・Z列
型番1 4　 4　 4　 4　 4　 ・・・2014/08/01←削除してSheetA内容に置き換え
型番2 5　 5　 5　 5　 5　 ・・・2014/08/01←削除してSheetA内容に置き換え
型番3 1　 1　 1　 1　 1　 ・・・2014/08/01←削除してSheetA内容に置き換え
型番4 7　 7　 7　 7　 7　 ・・・2014/08/01←削除してSheetA内容に置き換え　
型番5 4　 4　 4　 4　 4　 ・・・2014/08/01←削除してSheetA内容に置き換え　
型番6 6　 6　 6　 6　 6　 ・・・2014/08/01←SheetAに型番6は無い為更新なし

【SheetB】更新後
A列 　B列 C列 D列 E列 F列 ・・・Z列
型番1 7　 7　 7　 7　 7　 ・・・2014/08/01
型番2 5　 5　 5　 5　 5　 ・・・2014/08/05
型番3 8　 8　 8　 8　 8　 ・・・2014/07/01
型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　
型番5 4　 4　 4　 4　 4　 ・・・2014/08/15　　　　
型番6 6　 6　 6　 6　 6　 ・・・2014/08/01

どうか、よろしくお願いします。
【75996】Re:別シートの値と比較し、削除、追加を...
発言  カエムワセト  - 14/8/17(日) 22:33 -
引用なし
パスワード
   ht tp://www.vbalab.net/bbspolicy.html

>VBA質問箱基本ポリシー

>質問者の方へのお願い

>何をやったか書いてください
>おそらくあなたは、色々なことを試してできなかった末にここに質問を書くのでしょう。しかし回答者は、あなたが今まで何をやってきたか、何を知っていて何を知らないかわかりません。今まで試したこと、やろうと思ったけどやり方がわからなかったことなどをできるだけ詳しく書いてください。
【75997】Re:別シートの値と比較し、削除、追加を...
発言  MARUMO  - 14/8/18(月) 9:30 -
引用なし
パスワード
   ▼カエムワセト さん：
>ht tp://www.vbalab.net/bbspolicy.html
>
>>VBA質問箱基本ポリシー
>
>>質問者の方へのお願い
>
>>何をやったか書いてください
>>おそらくあなたは、色々なことを試してできなかった末にここに質問を書くので>しょう。しかし回答者は、あなたが今まで何をやってきたか、何を知っていて何を>知らないかわかりません。今まで試したこと、やろうと思ったけどやり方がわから>なかったことなどをできるだけ詳しく書いてください。

説明不足で申し訳ございません。
以下行削除の処理はできております。
これに行コピーの処理を追加したく、宜しくお願いします。

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lastRow1 As Long
Dim r As Long

Set ws1 = Sheets("SheetB")
Set ws2 = Sheets("SheetA")
lastRow1 = ws1.Range("D" & Rows.Count).End(xlUp).Row
For r = lastRow1 To 2 Step -1
If WorksheetFunction.CountIf(ws2.Columns("A"), ws1.Range("A" & r)) > 0 Then
ws1.Rows(r).Delete
Else
End If
Next
【75998】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 9:40 -
引用なし
パスワード
   ▼MARUMO さん：

>Bに同じ型番が存在すれば、
>Bの全て対象行を削除し、Aの対象型番をBへコピーしたい。
>
>【SheetA】
>A列 　B列 C列 D列 E列 F列 ・・・Z列
>型番3 8　 8　 8　 8　 8　 ・・・2014/07/01
>型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
>型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　
>
>【SheetB】更新前
>A列 　B列 C列 D列 E列 F列 ・・・Z列
>型番3 1　 1　 1　 1　 1　 ・・・2014/08/01←削除してSheetA内容に置き換え
>型番4 7　 7　 7　 7　 7　 ・・・2014/08/01←削除してSheetA内容に置き換え　


>【SheetB】更新後
>A列 　B列 C列 D列 E列 F列 ・・・Z列
>型番3 8　 8　 8　 8　 8　 ・・・2014/07/01
>型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
>型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　

サンプルデータおかしくないですか？
これだと、
【SheetA】に「型番3」が２つありますね？
【SheetB】のほうには１つしかないのだから、たとえば Match関数で【SheetB】
の「型番3」の位置を見つけ、それを
>【SheetA】
>型番3 8　 8　 8　 8　 8　 ・・・2014/07/01　　 …… (1)
>型番3 2　 2　 2　 2　 2　 ・・・2013/12/01　　 …… (2)
(1)番目の行データで置き換えたあと、
ふたたび Match関数で【SheetB】の「型番3」の位置を見つけ、同じ位置に
こんどは (2)番目の「型番3」データを上書きする、
という手順になるから、
更新後の【SheetB】に「型番3」の行が２つあることはありえません。

それと、日付をみると 【SheetB】更新前 のほうが 更新しようとしている
【SheetA】の日付より新しいのですが、古い日付データで更新してしまって
ほんとうにいいのですか？
【75999】Re:別シートの値と比較し、削除、追加を...
発言  MARUMO  - 14/8/18(月) 10:23 -
引用なし
パスワード
   ▼kanabun さん：
>▼MARUMO さん：
>
>>Bに同じ型番が存在すれば、
>>Bの全て対象行を削除し、Aの対象型番をBへコピーしたい。
>>
>>【SheetA】
>>A列 　B列 C列 D列 E列 F列 ・・・Z列
>>型番3 8　 8　 8　 8　 8　 ・・・2014/07/01
>>型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
>>型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　
>>
>>【SheetB】更新前
>>A列 　B列 C列 D列 E列 F列 ・・・Z列
>>型番3 1　 1　 1　 1　 1　 ・・・2014/08/01←削除してSheetA内容に置き換え
>>型番4 7　 7　 7　 7　 7　 ・・・2014/08/01←削除してSheetA内容に置き換え　
>
>
>>【SheetB】更新後
>>A列 　B列 C列 D列 E列 F列 ・・・Z列
>>型番3 8　 8　 8　 8　 8　 ・・・2014/07/01
>>型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
>>型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　
>
>サンプルデータおかしくないですか？
>これだと、
>【SheetA】に「型番3」が２つありますね？
>【SheetB】のほうには１つしかないのだから、たとえば Match関数で【SheetB】
>の「型番3」の位置を見つけ、それを
>>【SheetA】
>>型番3 8　 8　 8　 8　 8　 ・・・2014/07/01　　 …… (1)
>>型番3 2　 2　 2　 2　 2　 ・・・2013/12/01　　 …… (2)
>(1)番目の行データで置き換えたあと、
>ふたたび Match関数で【SheetB】の「型番3」の位置を見つけ、同じ位置に
>こんどは (2)番目の「型番3」データを上書きする、
>という手順になるから、
>更新後の【SheetB】に「型番3」の行が２つあることはありえません。
>
>それと、日付をみると 【SheetB】更新前 のほうが 更新しようとしている
>【SheetA】の日付より新しいのですが、古い日付データで更新してしまって
>ほんとうにいいのですか？

日付は気にしないでください。（混乱させてしまいました。すみません。）
>【SheetA】に「型番3」が２つありますね？
【SheetA】の方が、多い場合もあります。
単純に、同じ型番があれば1.、2.の処理
無ければ、2.のみ処理を行いたいのですが・・・

1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
2.SheetAの2行目から最終行までをSheetBの最終行+1
に貼り付け。
【76000】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 10:29 -
引用なし
パスワード
   ▼MARUMO さん：

>1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
>2.SheetAの2行目から最終行までをSheetBの最終行+1
>に貼り付け。

更新処理というのは ふつう こうやると思います。

If SheetB に同じ型番がみつかれば、SheetBのその行に

　　　SheetAデータをその行に上書き（更新）

Else　'その型番がみつからなければ
　　　
　　　SheetBの最終行+1 にデータ追加。

End If

---
行削除は不要です。
【76001】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 10:32 -
引用なし
パスワード
   上をコードにすると、こんな風です。

Sub Test更新1()
　　Dim A As Worksheet, B As Worksheet
　　Dim c As Range, r As Range
　　Dim m
　　
　　Set A = Worksheets("SheetA")
　　Set B = Worksheets("SheetB")
　　Set r = B.Range("A2", B.Cells(B.Rows.Count, 1).End(xlUp))
　　For Each c In A.Range("A2", _
　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp))
　　　　m = Application.Match(c, r, 0)
　　　　If IsNumeric(m) Then
　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き)
　　　　Else
　　　　　　　　　　　　　　　　　　　'新規データ追加
　　　　　　A.Rows(c.Row).Copy _
　　　　　　　B.Cells(B.Rows.Count, 1).End(xlUp).Offset(1)
　　　　End If
　　Next
End Sub
【76002】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 10:34 -
引用なし
パスワード
   （補足）↑ 列見出しのない表は考えられないので、
2行目からがデータ行と仮定して書いています。
【76003】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 10:49 -
引用なし
パスワード
   なのでほんとにサンプルのようなデータだった場合
（ただし1行目は列見出し）
更新後は
> 【SheetB】更新後
> A列 　B列 C列 D列 E列 F列 ・・・Z列
> 型番1 7　 7　 7　 7　 7　 ・・・2014/08/01
> 型番2 5　 5　 5　 5　 5　 ・・・2014/08/05
> 型番3 8　 8　 8　 8　 8　 ・・・2014/07/01
> 型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
> 型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　
> 型番5 4　 4　 4　 4　 4　 ・・・2014/08/15　　　　
> 型番6 6　 6　 6　 6　 6　 ・・・2014/08/01

でなく、以下のようになるはずです。

【SheetB】更新後
A列 　B列 C列 D列 E列 F列 ・・・Z列
型番1 7　 7　 7　 7　 7　 ・・・2014/08/01
型番2 5　 5　 5　 5　 5　 ・・・2014/08/05
型番3 2　 2　 2　 2　 2　 ・・・2013/12/01
型番4 7　 7　 7　 7　 7　 ・・・2014/01/10　
型番5 4　 4　 4　 4　 4　 ・・・2014/08/15　　　　
型番6 6　 6　 6　 6　 6　 ・・・2014/08/01
【76004】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 11:02 -
引用なし
パスワード
   ▼MARUMO さん：

前のと同じですが、追加先セル変数を1つ増やして、記述を簡単に
しました。

Sub Test更新2()
　　Dim A As Worksheet, B As Worksheet
　　Dim c As Range, r As Range, q As Range
　　Dim m
　　
　　Set A = Worksheets("SheetA")
　　Set B = Worksheets("SheetB")
　　Set q = B.Cells(B.Rows.Count, 1).End(xlUp) '[B]A列最終セル
　　Set r = B.Range("A2", q)
　　For Each c In A.Range("A2", _
　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp))
　　　　m = Application.Match(c, r, 0) 'SheetB にあるか？
　　　　If IsNumeric(m) Then
　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き)
　　　　Else
　　　　　　Set q = q.Offset(1)
　　　　　　A.Rows(c.Row).Copy q　　　'新規データ追加
　　　　End If
　　Next
End Sub
【76005】Re:別シートの値と比較し、削除、追加を...
発言  MARUMO  - 14/8/18(月) 11:28 -
引用なし
パスワード
   ▼kanabun さん：
>上をコードにすると、こんな風です。
>
>Sub Test更新1()
>　　Dim A As Worksheet, B As Worksheet
>　　Dim c As Range, r As Range
>　　Dim m
>　　
>　　Set A = Worksheets("SheetA")
>　　Set B = Worksheets("SheetB")
>　　Set r = B.Range("A2", B.Cells(B.Rows.Count, 1).End(xlUp))
>　　For Each c In A.Range("A2", _
>　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp))
>　　　　m = Application.Match(c, r, 0)
>　　　　If IsNumeric(m) Then
>　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き)
>　　　　Else
>　　　　　　　　　　　　　　　　　　　'新規データ追加
>　　　　　　A.Rows(c.Row).Copy _
>　　　　　　　B.Cells(B.Rows.Count, 1).End(xlUp).Offset(1)
>　　　　End If
>　　Next
>End Sub

ありがとうございました。
思っていた通りの事ができました。
検証用に、
SheetAに1つの型番(X型番)で10件のデータを用意しました。
追加されたデータは、10×4(4倍)の40件がSheetBにコピーされています。
何故4倍なのか???
X型番はSheetBに10件(削除できていない)準備していましたので
50件になりました。
【76006】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 11:55 -
引用なし
パスワード
   ▼MARUMO さん：

[SheetA]
　　 A　　B　　　C　　 D　
1　型番　枝番　 値1　 値2
2　A10　　1　　 100　 200
3　A10　　2　　 100　 300
4　A10　　3　　 200　 500


[SheetB] 更新前
　　A　　B　　　C　　 D　
1　型番　枝番　 値1　 値2
2　 A10　　no　　 0　　 0

---
上記のように [SheetA]に複数の型番「A10」があるときでも、処理は
[SheetA]の上から順番にループ処理していきますから、
まず[SheetA]の2行目が [SheetB]の2行目にコピーされ、
つぎは、[SheetA]の3行目が [SheetB]の2行目にコピーされ、
つぎは、[SheetA]の4行目が [SheetB]の2行目にコピーされるので、
結果は
[SheetB] 更新後
　　A　　B　　　C　　 D　
1　型番　枝番　 値1　 値2
2　 A10　　3　　 200　 500

となるはずです。
（同じ型番があったら、同じ行にコピー上書きされるので、
最後のデータだけがのこる）


>検証用に、
>SheetAに1つの型番(X型番)で10件のデータを用意しました。
>追加されたデータは、10×4(4倍)の40件がSheetBにコピーされています。
>何故4倍なのか???

どういうことか分かりません。
【76007】Re:別シートの値と比較し、削除、追加を...
発言  MARUMO  - 14/8/18(月) 11:56 -
引用なし
パスワード
   ▼kanabun さん：
>▼MARUMO さん：
>
>前のと同じですが、追加先セル変数を1つ増やして、記述を簡単に
>しました。
>
>Sub Test更新2()
>　　Dim A As Worksheet, B As Worksheet
>　　Dim c As Range, r As Range, q As Range
>　　Dim m
>　　
>　　Set A = Worksheets("SheetA")
>　　Set B = Worksheets("SheetB")
>　　Set q = B.Cells(B.Rows.Count, 1).End(xlUp) '[B]A列最終セル
>　　Set r = B.Range("A2", q)
>　　For Each c In A.Range("A2", _
>　　　　　　　　　　　　　A.Cells(A.Rows.Count, 1).End(xlUp))
>　　　　m = Application.Match(c, r, 0) 'SheetB にあるか？
>　　　　If IsNumeric(m) Then
>　　　　　　A.Rows(c.Row).Copy r(m)　 '既存データ更新(上書き)
>　　　　Else
>　　　　　　Set q = q.Offset(1)
>　　　　　　A.Rows(c.Row).Copy q　　　'新規データ追加
>　　　　End If
>　　Next
>End Sub

ありがとうございました。
思っていた通りの事ができました。
検証用に、
SheetAに1つの型番(X型番)で10件のデータを用意しました。
追加されたデータは、10×4(4倍)の40件がSheetBにコピーされています。
何故4倍なのか???
X型番はSheetBに10件(削除できていない)準備していましたので
50件になりました。

同じ型番が2件(行)以上存在する事もありますので
SheetAに2行あれば、SheetBが1行だったとしても
SheetAに2行と置き換えしたいです。

SheetAの方は、型番が複数存在するイメージで
書いてしまってました。
今の所、同じ型番が複数行になる見込みだそうです。
（すみません。先程わかりました）
【76008】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 12:20 -
引用なし
パスワード
   ▼MARUMO さん：

>同じ型番が2件(行)以上存在する事もありますので
>SheetAに2行あれば、SheetBが1行だったとしても
>SheetAに2行と置き換えしたいです。
>
それは、むつかしいですよ
「型番」だけで判断すれば、同じ型番があったら、データ作成時期は
ちがうかもしれないけれど、同じデータのはずです。

そもそも[SheetA]になぜ複数の同じ型番が存在するのですか？

さっき言ったように、同じ型番でも出所がちがうとか、区別される項目が
あるのなら、「型番」だけでなく、他と区別できる（その識別できる）項目
を加えて、行を特定しなければならないはずですけど？

もしSheetA に4つの同じ型番データがあったとして、SheetB にある同じ
型番データは SheetAの「どの」データと置き換えるのですか？
あるいは、SheetB に現在ある同じ型番データは SheetA の4つのデータと
みな違う種類のものだとしたら、SheetBのデータを削除することなく、
あらたに SheetAの4つのデータを追加しなければいけないはずです。

SheetA にあるだけ全部 SheetB に「追加」したとして、
次回のときは SheetB に同じ型番が複数存在することになりますけど、
どうやって 対応をつけるんでしょう？
【76009】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 14:44 -
引用なし
パスワード
   ▼MARUMO さん：

>SheetAの方は、型番が複数存在するイメージで
>書いてしまってました。
>今の所、同じ型番が複数行になる見込みだそうです。
>（すみません。先程わかりました）

> 1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
> 2.SheetAの2行目から最終行までをSheetBの最終行+1
> に貼り付け。

この処理は

1. SheetA の複製を作り（SheetA'とする）
2. SheetBの型番を上から順に見ていって SheetA'になかったら、
　　SheetA'の最終行+1行にコピーして追加。
3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。

と同じことだと思うけど？
そうなら、後者の方法のほうが作業量が少ない（行削除しない）ので
効率的ですよね？
【76010】Re:別シートの値と比較し、削除、追加を...
発言  MARUMO  - 14/8/18(月) 15:11 -
引用なし
パスワード
   ▼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
【76011】Re:別シートの値と比較し、削除、追加を...
お礼  MARUMO  - 14/8/18(月) 16:09 -
引用なし
パスワード
   ▼kanabun さん：
>▼MARUMO さん：
>
>>SheetAの方は、型番が複数存在するイメージで
>>書いてしまってました。
>>今の所、同じ型番が複数行になる見込みだそうです。
>>（すみません。先程わかりました）
>
>> 1.SheetBに同じ型番がみつかれば、SheetBからすべて削除
>> 2.SheetAの2行目から最終行までをSheetBの最終行+1
>> に貼り付け。
>
>この処理は
>
>1. SheetA の複製を作り（SheetA'とする）
>2. SheetBの型番を上から順に見ていって SheetA'になかったら、
>　　SheetA'の最終行+1行にコピーして追加。
>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。
>
>と同じことだと思うけど？
>そうなら、後者の方法のほうが作業量が少ない（行削除しない）ので
>効率的ですよね？

15:11の補足です。
非常に助かりました。
ありがとうございました。
【76012】Re:別シートの値と比較し、削除、追加を...
発言  kanabun  - 14/8/18(月) 18:59 -
引用なし
パスワード
   ▼MARUMO さん：

>>1. SheetA の複製を作り（SheetA'とする）
>>2. SheetBの型番を上から順に見ていって SheetA'になかったら、
>>　　SheetA'の最終行+1行にコピーして追加。
>>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。

参考まで（というか、自分のメモ）です。

Sub Try3()
　　Dim newBook As Workbook
　　Dim A As Worksheet
　　Dim B As Worksheet
　　Dim r As Range, q As Range, c As Range
　　
　　Set B = Worksheets("db")
　　Worksheets("wk").Copy　　　 '複製を作成(newBook)
　　Set newBook = ActiveWorkbook
　　Set A = newBook.Worksheets(1)
　　With A
　　　　Set q = .Cells(.Rows.Count, "D").End(xlUp) '最終セル
　　　　Set r = .Range("D2", q)
　　　　Set q = q.EntireRow.Range("A1")
　　End With
　　'[B]の型番が[A]になければ [A]の最終行＋1に追加Copyする
　　For Each c In B.Range("D2", B.Cells(Rows.Count, "D").End(xlUp))
　　　　If WorksheetFunction.CountIf(r, c) = 0 Then
　　　　　　Set q = q.Offset(1)
　　　　　　c.EntireRow.Copy q
　　　　End If
　　Next
　　'このあと newBookに名前をつけて保存
　　
End Sub
【76013】Re:別シートの値と比較し、削除、追加を...
お礼  MARUMO  - 14/8/18(月) 21:59 -
引用なし
パスワード
   ▼kanabun さん：
>▼MARUMO さん：
>
>>>1. SheetA の複製を作り（SheetA'とする）
>>>2. SheetBの型番を上から順に見ていって SheetA'になかったら、
>>>　　SheetA'の最終行+1行にコピーして追加。
>>>3. 最後にもとのSheetB を削除して SheetA' を SheetB に改名。
>
>参考まで（というか、自分のメモ）です。
>
>Sub Try3()
>　　Dim newBook As Workbook
>　　Dim A As Worksheet
>　　Dim B As Worksheet
>　　Dim r As Range, q As Range, c As Range
>　　
>　　Set B = Worksheets("db")
>　　Worksheets("wk").Copy　　　 '複製を作成(newBook)
>　　Set newBook = ActiveWorkbook
>　　Set A = newBook.Worksheets(1)
>　　With A
>　　　　Set q = .Cells(.Rows.Count, "D").End(xlUp) '最終セル
>　　　　Set r = .Range("D2", q)
>　　　　Set q = q.EntireRow.Range("A1")
>　　End With
>　　'[B]の型番が[A]になければ [A]の最終行＋1に追加Copyする
>　　For Each c In B.Range("D2", B.Cells(Rows.Count, "D").End(xlUp))
>　　　　If WorksheetFunction.CountIf(r, c) = 0 Then
>　　　　　　Set q = q.Offset(1)
>　　　　　　c.EntireRow.Copy q
>　　　　End If
>　　Next
>　　'このあと newBookに名前をつけて保存
>　　
>End Sub
ありがとうございます。
今後の為に、参考させていただきます。
大変お世話になりました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
1155 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free