質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

90.12%

シート間の条件付き行コピーと重複データ対応

受付中

回答 2

投稿 編集

  • 評価
  • クリップ 0
  • VIEW 1,013
退会済みユーザー

退会済みユーザー

 前提・実現したいこと

シート1からシート2へ特定文字を含む行をコピー・転記し、内容が重複するものはデータを上書きする方法探しています。
<シート1>

A B C D E F G H I J
1 日付 所属 客先 役職 氏名 氏名2 氏名3 進捗 内容
2

1行目に項目で2行目以降は各フォルダから吸い上げたデータが並んでいます。

<シート2>

A B C D E F G H I J
1 日付 所属 客先 役職 氏名 氏名2 氏名3 進捗 内容
2

フォーマットはシート1と一緒です。

<条件>
シート1のH列に”訪問”と入っている行を抽出し、シート2の2行目以降に反映。
反映時にシート2に重複するデータ(行)があれば上書きする

 発生している問題・エラーメッセージ

重複するデータも抽出し反映している。
1行目の項目欄にも反映してしまっている。

 該当のソースコード

Sub 訪問企業()
Dim wbRead As Workbook
Dim wbOut As Workbook
Dim shtRead As Worksheet
Dim shtOut As Worksheet

Set wbRead = ActiveWorkbook
Set wbOut = Workbooks("集計.xlsm")
Set shtRead = wbOut.Worksheets("全体")
Set shtOut = wbOut.Worksheets("訪問")

Dim rng As Range
Dim lastRow As Long

'現在のブック内にあるすべてのシートをループ処理
For Each shtRead In wbRead.Worksheets
'対象シート内のH列先頭からH列最終データ行までをループ処理
For Each rng In shtRead.Range(shtRead.Cells(8, 1), shtRead.Cells(shtRead.Rows.Count, 1).End(xlUp))
'H列が「訪問」なら、
If shtRead.Cells(rng.Row, 8) = "訪問" Then
'読込シートから行コピー
shtRead.Rows(rng.Row).Copy

'A~J列全体から、重複データを探して、選択する。
Dim KENSAKU As Variant
KENSAKU = shtRead.Range("A1:J63000")
Dim FoundCell As Range
Set FoundCell = shtOut.Range("A:J").Find(What:=KENSAKU, LookAt:=xlWhole)

'【重複ない場合】空白の行に内容を転記
If FoundCell Is Nothing Then
'DBブックを選択し、一番下の行番号を取得
lastRow = shtOut.Cells(Rows.Count, 1).End(xlUp).Row + 1
'出力シートに値で貼り付け
shtOut.Rows(lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

'【重複ある場合】同じ検索用の内容の行に上書きする
Else
'その行に貼付け
shtOut.Rows(FoundCell.Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End If
End If
Next rng
Next shtRead

Application.CutCopyMode = True
ActiveCell.Select

End Sub

 試したこと

マクロ初心者でどこをいじればいいのか分かりません。

 補足情報(FW/ツールのバージョンなど)

Windows7/Excel ver.10

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

質問への追記・修正、ベストアンサー選択の依頼

  • 退会済みユーザー

    2018/10/19 13:30

    複数のユーザーから「やってほしいことだけを記載した丸投げの質問」という意見がありました
    「質問を編集する」ボタンから編集を行い、調査したこと・試したことを記入していただくと、回答が得られやすくなります。

回答 2

+1

そもそも、VBAなど不要。
ピボットテーブルにするのもいいし、重複の削除の機能で十分。

図は、重複の削除の方法。
イメージ説明

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

0

シート1からシート2へ特定文字を含む行をコピー・転記し、内容が重複するものはデータを上書きする方法探しています。

VBAが不要というのは極論だと思いますが、
VBAで自動化しなくても、エクセルの機能を使えば、
そんなに難しくなく、希望の結果が得られます。

希望の動作を実現するには、
「フィルターオプション」(今は公式には使われてない?なんていうんだろう?)
という機能で実現できます。
ただし、この機能を手動で行うには、シート上をかなり汚さないと
(イメージしている結果に関係ないことをシート上に書かないといけない。)いけないので、
敬遠されがちですが、VBAでその作業をやるなら、
自動で追記したり消したり自由自在ですので、そういうものを「見せない」ということができます。

(Excel2010のリボン上では、データタブ→並び替えとフィルター→詳細設定というボタンです。)

フィルターオプションという機能では、
別のシートに意図した行あるいは列だけコピー
重複の削除
という機能が内包されています(仕様を確認のこと)ので、
希望の結果を得るのに非常に少ないコード量で開発ができます。
(その代り作業用のシートを用意したりしなければいけないですが)
ぜひ、検討してみてください。

参考URL>>
http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/vba_advancedfilter.html

投稿

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 90.12%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる