エクセル（EXCEL）のワークシートの結合について

質問

こんにちは。どうしてもできないのでお力をお貸し下さい。

（質問内容）
同じフォームのエクセルのワークシートで、毎日新しい数十件の物流情報が手元に届きます。私の仕事は、一日前に作ったワークシートにその日届いたばかりの新しいワークシートの情報をマージしてお客様へ転送しています。

毎日届くワークシートには前日までの古い物流情報も載って来ます。つまり、新しいワークシートをそのまま転送するのではなく、古いワークシートにマージして、新しいワークシートで内容に変更があった行と、全く新しい追加行のセルだけハイライトして、お客様に当日分の物流情報として分かるようにする必要があります。このワークシートのマージを手作業でやっているため、以下の手作業が発生しています。

１．新しいワークシートの全てのセルをコピーして前日のワークシートの最終行のすぐ後にペーストする。
２．製品番号でソートして同じ製品番号のものを上下で並べる。
３．上下の行をよく比べて、内容の変更のあったものについては、新しい行で古い行を上書きし、その行をハイライトする。全く新しい製品行が追加されている場合は、そのままその行をハイライトする。
４．最後に製品番号で重複するものを削除する。

という風にして、当日届いた情報を前日までのものに追加して、その内容で変更のあったものと、追加行をハイライトする訳です。

この作業をマクロを使って自動化できないでしょうか？少し複雑ですが、何卒宜しくお願いします。

回答No.11

at121 · ベストアンサー

品番が空白ではどういう条件なのか・・
シート2　新データ　品番空白の場合上の行の品番を写して良いのか・・
マクロによる操作の記録・モジュールの編集はできているのか・・

データモデル　シート1　前データ　
品番 BB CC DD
101 11b 11c
104 41d 41c
105 51d

データモデル　シート2　新データ
品番 bb cc dd
101 12b
13c
105 52b 52d
106 62b 62c

Sub シート1へシート2の更新情報を反映しハイライト()

'課題3　予備処理
With Sheets(2)
'シート2　新データの更新行　予備マーキング　薄青色
.Range("A1").CurrentRegion.Interior.ColorIndex = 34 '更新行のハイライト　薄青色
'シート2にA列 製品番号　空白行に ダミーの製品番号を挿入 (空白の場合上から複写)
最終行 = .Range("A1").CurrentRegion.Rows.Count
For 確認行 = 2 To 最終行
If .Cells(確認行, 1).Value = "" Then
.Cells(確認行, 1).Value = .Cells(確認行 - 1, 1).Value
End If
Next

End With

With Sheets(1)

'課題3　予備処理　シート1　前データのハイライト解除
.Range("A1").CurrentRegion.Interior.ColorIndex = xlNone

'課題1 シート1　前データに　シート2の更新データを追加挿入

末尾行 = .Range("A1").CurrentRegion.Rows.Count
'課題1 シート2の新データをコピー
Sheets(2).Range("A1").CurrentRegion.Copy
'課題1 シート1　末尾に　新データを追加挿入
.Cells(末尾行 + 1, 1).Insert Shift:=xlDown
'Sheets(2).行１　は　見出し　行として削除
.Rows(末尾行 + 1).Delete Shift:=xlUp

'課題2 A列製品番号でソートする
'Sheets(1).行１　は　見出し　行
.Range("A1").CurrentRegion.Sort Key1:=Sheets(1).Range("A1"), Header:=xlYes

'課題3、4 A列製品番号の重複行の更新ハイライトと更新後削除

最終行 = .Range("A1").CurrentRegion.Rows.Count
最終列 = .Range("A1").CurrentRegion.Columns.Count

For 確認行 = 2 To 最終行 - 1
'A列　製品番号　空白は　処理終了
If Trim(.Cells(確認行 + 1, 1).Value) = "" Then Exit For

If StrComp(.Cells(確認行, 1).Value, .Cells(確認行 + 1, 1).Value, vbTextCompare) = 0 Then

'A列製品番号の重複行（旧：確認行　vs　新：確認行+１）の各項目の比較
For 確認列 = 2 To 最終列
If Trim(.Cells(確認行 + 1, 確認列).Value) = "" Then
'空白項目の転写
.Cells(確認行 + 1, 確認列).Value = .Cells(確認行, 確認列).Value
'.Cells(確認行 + 1, 確認列).Interior.ColorIndex = 34 '更新項目のハイライト　なし
ElseIf Not (StrComp(.Cells(確認行, 確認列).Value, .Cells(確認行 + 1, 確認列).Value, vbTextCompare) = 0) Then
'更新データあり（　テキスト　比較　aAＡａ区別せず）　
'.Cells(確認行 + 1, 確認列).Value = .Cells(確認行, 確認列).Value
.Cells(確認行 + 1, 確認列).Interior.ColorIndex = 6 '更新項目のハイライト　薄黄色

End If
Next

'課題4　 重複した　旧：確認行　の削除
.Rows(確認行).Delete Shift:=xlUp
確認行 = 確認行 - 1
End If
Next
End With

End Sub

お礼

お礼が遅くなり、誠に申し訳ありません。今週一杯出張で不在にしておりましたので、まだ本番データで検証ができておりません。恐れ入りますが、もう少しの間時間を下さい。来週以降で時間が見つけられ次第、本番データで詳細にテストしてみます。本当にありがとうございます。

補足

ご回答、心より感謝いたします。一両日中に試してみたいと思います。結果は必ず報告いたしますので、宜しくお願いいたします。ありがとうございました。

回答No.13

KenKen_SP

KenKen_SPです。

＞大きな部分は正常に動いているようです

うまくいかない部分があったのですか？

お礼

回答が遅くなり申し訳ありませんでした。全てうまく行きました。多分テストデータの作り方が悪かっただけです。すみません。ワンダフルです！感動しました。本当にありがとうございます。

回答No.12

KenKen_SP

marukai7 さん見てますかー。

長すぎですが、コードをアップしておきます。ただ、実際のデータの感じが全然つかめないので想像による部分があります。
前提としては、

1.　A列は製品番号
2.　新旧シートは同一ブック内にある
3.　セル結合は一切なし
4.　製品番号が空のものは比較対象外
5.　細かなエラートラップはしてない
5.　本当は新規データを基準にした方が良いと思っている
6.　汚いコードだし、無駄が多い点にはツッコミ不要

5-6は無視して下さい（汗）

【以下コード】

Option Explicit

Sub Sample()

　　Dim rngDat As Range
　　Dim aryOld, aryNew, aryBuf, tmp
　　Dim Dic As Object
　　Dim Buf As String, strMes As String
　　Dim i As Long, j As Long, Cnt As Long
　　Dim Cn As Long, Ca As Long
　　Dim NewSh As Worksheet

　　'データの範囲と値を取得--------------------------------------------

　　'旧データを配列に格納（見出し行含む）
　　Set rngDat = Application.InputBox( _
　　　　Prompt:="旧データのセルをひとつ選択し、[OK]をクリック", Type:=8)
　　　　aryOld = rngDat.CurrentRegion
　　'新データを配列に格納（見出し行はカット）
　　Set rngDat = Application.InputBox( _
　　　　Prompt:="新データのセルをひとつ選択し、[OK]をクリック", Type:=8)
　　　　With rngDat.CurrentRegion
　　　　　　aryNew = .Offset(1, 0).Resize(.Rows.Count - 1)
　　　　End With
　　Set rngDat = Nothing

　　'Dictionaryオブジェクト生成----------------------------------------
　　Set Dic = CreateObject("Scripting.Dictionary")

　　'旧データをDictionaryに登録----------------------------------------
　　For i = LBound(aryOld) To UBound(aryOld)

　　　　'各要素を<>区切りで連結し比較データ生成
　　　　Buf = ""
　　　　For j = LBound(aryOld, 2) To UBound(aryOld, 2)
　　　　　　Buf = Buf & aryOld(i, j) & "<>"
　　　　Next j

　　　　'キーがEmptyの場合、ダミーのキーをセット
　　　　Cnt = 1
　　　　If IsEmpty(aryOld(i, 1)) Then
　　　　　　aryOld(i, 1) = "Dummy" & Cnt
　　　　　　Cnt = Cnt + 1
　　　　End If

　　　　'旧データをDictionaryに登録（KEY=製品番号,ITEM=比較用連結データ）
　　　　If Not Dic.Exists(aryOld(i, 1)) Then
　　　　　　'旧データ識別子を付与
　　　　　　Dic.Add Key:=aryOld(i, 1), Item:=Buf & "OLD"
　　　　Else
　　　　　　'キー重複トラップ
　　　　　　strMes = "キー：" & aryOld(i, 1) & "が重複しています。"
　　　　　　GoTo ErrorHandler
　　　　End If

　　Next i
　　Erase aryOld

　　'新データとDictionaryの内容を比較----------------------------------
　　For i = LBound(aryNew) To UBound(aryNew)

　　　　'各要素を<>区切りで連結し比較データ生成
　　　　Buf = ""
　　　　For j = LBound(aryNew, 2) To UBound(aryNew, 2)
　　　　　　Buf = Buf & aryNew(i, j) & "<>"
　　　　Next j

　　　　'キーがEmptyの場合、ダミーキーをセット
　　　　If IsEmpty(aryNew(i, 1)) Then
　　　　　　aryNew(i, 1) = "Dummy" & Cnt
　　　　　　Cnt = Cnt + 1
　　　　End If

　　　　If Not Dic.Exists(aryNew(i, 1)) Then
　　　　　　'Dictionaryに同一キーがなければ追加
　　　　　　Dic.Add Key:=aryNew(i, 1), Item:=Buf & "ADD" '追加データ識別子
　　　　Else
　　　　　　'Dictionaryに同一キーがあれば比較
　　　　　　tmp = Replace(Left$(Dic.Item(aryNew(i, 1)), _
　　　　　　　　　　　　Len(Dic.Item(aryNew(i, 1))) - 3), "<>", "")
　　　　　　If Not StrComp(tmp, Replace(Buf, "<>", ""), vbTextCompare) = 0 Then
　　　　　　　　'異なればDirectoryのItemを更新
　　　　　　　　Dic.Item(aryNew(i, 1)) = Buf & "NEW" '更新データ識別子
　　　　　　End If
　　　　End If

　　Next i
　　Erase aryNew

　　'Dictionaryの内容を出力--------------------------------------------
　　Set NewSh = Sheets.Add(After:=Sheets(Sheets.Count))

　　'DirectoryオブジェクトのItemを配列に展開
　　aryBuf = Dic.Items
　　With NewSh
　　　　For i = 0 To UBound(aryBuf)
　　　　　　'<>区切りで再配列化（識別子はカット）
　　　　　　tmp = Split(Left$(aryBuf(i), Len(aryBuf(i)) - 5), "<>")
　　　　　　'転記
　　　　　　With .Cells(i + 1, 1).Resize(, UBound(tmp) + 1)
　　　　　　　　.Value = tmp
　　　　　　　　'識別子でセル書式設定の分岐
　　　　　　　　Select Case Right$(aryBuf(i), 3)
　　　　　　　　　　Case Is = "NEW"
　　　　　　　　　　　　'更新データ
　　　　　　　　　　　　.Interior.ColorIndex = 36
　　　　　　　　　　　　Cn = Cn + 1 '更新データカウンタ
　　　　　　　　　　Case Is = "ADD"
　　　　　　　　　　　　'追加データ
　　　　　　　　　　　　.Interior.ColorIndex = 35
　　　　　　　　　　　　Ca = Ca + 1 '追加データカウンタ
　　　　　　　　　　Case Else
　　　　　　　　　　　　.Interior.ColorIndex = xlNone
　　　　　　　　End Select
　　　　　　End With
　　　　Next i

　　　　'最終処理------------------------------------------------------
　　　　.Cells.EntireColumn.AutoFit 'セル幅調整
　　　　With .Range("A1").CurrentRegion
　　　　　　'並べ替え
　　　　　　.Sort Key1:=Range("A2"), Header:=xlGuess
　　　　　　.Font.Name = "Arial"
　　　　End With
　　End With

　　MsgBox "更新データ数：" & Cn & vbCrLf & _
　　　　　　"追加データ数：" & Ca

ExitHandler:
　　Set Dic = Nothing
　　Set NewSh = Nothing
　　Exit Sub

ErrorHandler:
　　MsgBox strMes, vbCritical, "処理中止"
　　GoTo ExitHandler

End Sub

お礼

検証に時間がかかってしまい、誠に申し訳ありません。今週いっぱい出張に出向いておりまして、詳細なテストは終了してない状況です。但し、大きな部分は正常に動いているようです。本当にありがとうございました。お礼が遅くなってしまい恐縮です。詳細な部分でまた質問が出てまいりましたら、再度質問させていただくかもしれません。何卒宜しくお願いいたします。本当にありがとうございます。

補足

ご回答誠ににありがとうございます。一両日中に早速使用してみます。少し時間をいただいていいですか？結果、報告させていただきますので宜しくお願いします。

回答No.10

KenKen_SP

＞１．新しいワークシートの全てのセルをコピーして前日のワークシートの最終行のすぐ後にペーストする。

marukai7さんのこの方法は、「新しいデータ」を「古いデータ」にマージするわけですから、新しいシート側で削除された製品でも、古いシート側にその製品のデータがあった場合、
このデータがいつまでも残ることになります。

つまり、「追加」「更新」だけでなく「削除」も必要なのだと思うのです。考慮する必要がありますか？

回答No.9

KenKen_SP

＞１．全く空白の行はありませんが、キーとなる列に空白のセルが存在します。

キー列に空白セルが存在する、、では新旧データを比較する方法がありません。ソート際にも障害になります。キー列が空の行のデータは比較する必要がないのでしょうか？

＞＞[Ctrl]+[*]キーで取得できるデータ範囲でOKですか？
＞当方、海外勤務で英語バージョンのWindowsを使っていますが"No outline exists." "Cannot create outline."と表示されてしまいます。

英語版と日本語版でショートカットキーが異なるみたいですね。では、データのあるシートを選択した状態で、下記コードを実行してみて下さい。

Sub SelectDataArea()
　　Range("A1").CurrentRegion.Select
End Sub

これで、処理の対象としたいセルが全て選択されていますか？

＞３．できればフォントがArialが希望です。

わかりました。しかし、一番知りたいのは、罫線やフォントの色なども複写する必要があるのかどうかです。つまり、書式を含めたセルごとコピーしなければならないのか、値のみ転記できればよいのかの違いです。

回答No.8

at121

前提　　A列が製品番号
課題1　シート1（シート名を問わず）末尾に
　　　　シート2（シート名を問わず）のデータ（空白まで）を追加
Sub シート1にシート2のデータを追加するだけ()
Sheets(2).Range(Sheets(2).Rows("1"), Sheets(2).Rows("1").End(xlDown)).Copy
末尾行 = Sheets(1).Range("A1").End(xlDown).Row
Rows(末尾行 + 1).Insert Shift:=xlDown
End Sub

課題2　１行目からデータ＞１行目が見出し行があるなら修正する
　　　　Kye2に日付列　が合ったほうが良い。
Sub A列製品番号でソートするだけ()
Cells.Select
Selection.Sort Key1:=Range("A1")
End Sub

課題4　ソートしたのでA列製品番号には空白行がない
Sub A列製品番号の重複を削除するだけ()
最終行 = Range("A1").End(xlDown).Row
For 確認行 = 最終行 To 1 Step -1
If Cells(確認行, 1).Value = Cells(確認行 - 1, 1).Value Then
Rows(確認行 - 1).Delete Shift:=xlUp
確認行 = 確認行 - 1
End If
Next
End Sub

課題3は　1行しかないとき　新しい製品行か　従来の行か
　　　　　判別する手段・日付列　か　フラグが必要なので　保留
　　　　課題4の　Forループ　if　分岐にて処理可

お礼

回答が遅くなりましてすみません。出張など重なり、忙殺されて本番データを使ってテストする時間がなかなか見つかりませんでした。すみません。最後にいただいたＰＧＭを使ったテストの結果は完璧でした。本当にありがとうございました。結果を見て感動を覚えました。心より御礼申し上げます。

回答No.7

KenKen_SP

こんにちは。

＞..マクロやプログラムはまだ一切組めていません。

丸なげはどうかと思いますが、自分の勉強も兼ねてコードを書いてみました。しかし、非常に長く、冗長で、きたないコードです。

それでも宜しければアップしますが、もうこのスレッドは読んでいらっしゃいませんか？

もし、コードのアップを御希望される場合は、下記の補足をお願いします。

1.　データはA1セルから始まり、データの終わりまでに空白行はありませんか？
　　--＞[Ctrl]+[*]キーで取得できるデータ範囲でOKですか？
2.　見出し行はありますか？
3.　転記は値のみで、セル書式は考慮しなくても良いですか？
4.　「ハイライト」とはセルに背景色を設定するという意味？
5.　新旧データの比較は大小・全半角などを区別する必要は？

補足

いつもアドバイスありがとうございます。他の過去ログを拝見したりしながらマクロを組んでみるも動かず、経験がないのでUpできるような代物にならず終いです。

早速ですがご質問に回答させていただきます。
１．全く空白の行はありませんが、キーとなる列に空白のセルが存在します。
＞[Ctrl]+[*]キーで取得できるデータ範囲でOKですか？
当方、海外勤務で英語バージョンのWindowsを使っていますが"No outline exists." "Cannot create outline."と表示されてしまいます。
２．見出し行は一行あります。
３．できればフォントがArialが希望です。
４．ハイライトとは追加・変更のあるセルだけではなくて、その行全体のセルに背景色をつけるという意味です。
５．新旧データの比較で大小・全半角を区別する必要はありません。

以上、回答させていただきます。お手数で大変恐縮ですが何卒宜しくお願いいたします。

回答No.6

pierre_1999

「マッチングマクロ高速版Ver6.1」（6,800円）
のページがあったので添付します。

参考URL：

http://www.vector.co.jp/soft/win95/business/se281725.html?g

補足

ありがとうございます。先日、教わった「ベリファイエクセル」を諦めずに何度もトライしていましたが、どうやら症状は、二つのシートを比較して、内容の異なるセルを見つけたら、新しいシートを自動的に作り、該当位置のセルをハイライトするところまでは問題ないことが分かりました。但し、そのセルはハイライトされるだけで中身は空白のままで、結果は何もないシートにぽつぽつと赤いセルが現れるだけなのです。私の期待している結果は新旧二つのシートを比べて古いシートの内容を新しい内容で書き換えることですので、新しいシートの中身もそのハイライトされたセルに載って欲しいのですが・・・。もし、これができれば「ベリファイエクセル」で十分です。

回答No.5

pierre_1999

#4です。

＞EXCEL2003です。最新バージョンなのですが。

それだと出来るはずですよね。
ダウンロード中に不具合が出るのかもしれませんね。

お金がかかってもよいなら、次の本にも当ソフトが
入っていますので試してみてください。

成美堂出版
SEIBIDO　MOOK「使えるEXCELフリー＆シェアソフト厳選360　2005年版」（CD-ROM版）　998円

この本は1月中旬頃からコンビニ等で販売されてたものです。コンビニにはもう無くとも本屋にはあると思います。
この本の41ページ、42ページに「比較・抽出・置換ソフト」が6本紹介されています。
お金を気にしなければシェアウェアの「マッチングマクロ高速版Ver6.1」というのが一番使えるかもしれません。

「マッチングマクロ高速版Ver6.1」（6,800円）
データを指定したキーでマッチングさせて転送できる。
複数のキーや未ソートデータ、別シート・ブック間での
処理にも対応。
VLOOKUP関数での機能をより使いやすく充実させたマクロ。
製作者：EC研究所

回答No.4

pierre_1999

#2です。

>何度も試みましたが、どうしてもエラーが複数箇所出てしまいます。更に調査しています。

Ms-Excelのバージョンは何ですか？
このソフトはExcel2000以上でないと動かないようです。
97とかだと無理かもしれませんね。

補足

EXCEL2003です。最新バージョンなのですが。

回答No.3

KenKen_SP

＞こんにちは。どうしてもできないのでお力をお貸し下さい。
＞この作業をマクロを使って自動化できないでしょうか？

自動化はVBAでやるしかありませんが、どこまでやって、できないのはどこなのでしょう？

お礼

すみません、試行錯誤でEXCELに既についている機能を使ってシートのマージを試みたという意味で、マクロやプログラムはまだ一切組めていません。どうかアドバイスよろしくお願いします。