こんにちは。どうしてもできないのでお力をお貸し下さい。
(質問内容)
同じフォームのエクセルのワークシートで、毎日新しい数十件の物流情報が手元に届きます。私の仕事は、一日前に作ったワークシートにその日届いたばかりの新しいワークシートの情報をマージしてお客様へ転送しています。
毎日届くワークシートには前日までの古い物流情報も載って来ます。つまり、新しいワークシートをそのまま転送するのではなく、古いワークシートにマージして、新しいワークシートで内容に変更があった行と、全く新しい追加行のセルだけハイライトして、お客様に当日分の物流情報として分かるようにする必要があります。このワークシートのマージを手作業でやっているため、以下の手作業が発生しています。
1.新しいワークシートの全てのセルをコピーして前日のワークシートの最終行のすぐ後にペーストする。
2.製品番号でソートして同じ製品番号のものを上下で並べる。
3.上下の行をよく比べて、内容の変更のあったものについては、新しい行で古い行を上書きし、その行をハイライトする。全く新しい製品行が追加されている場合は、そのままその行をハイライトする。
4.最後に製品番号で重複するものを削除する。
という風にして、当日届いた情報を前日までのものに追加して、その内容で変更のあったものと、追加行をハイライトする訳です。
この作業をマクロを使って自動化できないでしょうか?少し複雑ですが、何卒宜しくお願いします。
No.11ベストアンサー
- 回答日時:
品番が空白ではどういう条件なのか・・
シート2 新データ 品番空白の場合上の行の品番を写して良いのか・・
マクロによる操作の記録・モジュールの編集はできているのか・・
データモデル シート1 前データ
品番BBCCDD
10111b11c
10441d41c
10551d
データモデル シート2 新データ
品番bbccdd
10112b
13c
10552b52d
10662b62c
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).行1 は 見出し 行として削除
.Rows(末尾行 + 1).Delete Shift:=xlUp
'課題2 A列製品番号でソートする
'Sheets(1).行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 新:確認行+1)の各項目の比較
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
'更新データあり( テキスト 比較 aAAa区別せず)
'.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
この回答への補足
ご回答、心より感謝いたします。一両日中に試してみたいと思います。結果は必ず報告いたしますので、宜しくお願いいたします。ありがとうございました。
補足日時:2005/02/18 07:56お礼が遅くなり、誠に申し訳ありません。今週一杯出張で不在にしておりましたので、まだ本番データで検証ができておりません。恐れ入りますが、もう少しの間時間を下さい。来週以降で時間が見つけられ次第、本番データで詳細にテストしてみます。本当にありがとうございます。
No.12
- 回答日時:
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
この回答への補足
ご回答誠ににありがとうございます。一両日中に早速使用してみます。少し時間をいただいていいですか?結果、報告させていただきますので宜しくお願いします。
補足日時:2005/02/18 07:54検証に時間がかかってしまい、誠に申し訳ありません。今週いっぱい出張に出向いておりまして、詳細なテストは終了してない状況です。但し、大きな部分は正常に動いているようです。本当にありがとうございました。お礼が遅くなってしまい恐縮です。詳細な部分でまた質問が出てまいりましたら、再度質問させていただくかもしれません。何卒宜しくお願いいたします。本当にありがとうございます。
No.10
- 回答日時:
>1.新しいワークシートの全てのセルをコピーして前日のワークシートの最終行のすぐ後にペーストする。
marukai7さんのこの方法は、「新しいデータ」を「古いデータ」にマージするわけですから、新しいシート側で削除された製品でも、古いシート側にその製品のデータがあった場合、
このデータがいつまでも残ることになります。
つまり、「追加」「更新」だけでなく「削除」も必要なのだと思うのです。考慮する必要がありますか?
No.9
- 回答日時:
>1.全く空白の行はありませんが、キーとなる列に空白のセルが存在します。
キー列に空白セルが存在する、、では新旧データを比較する方法がありません。ソート際にも障害になります。キー列が空の行のデータは比較する必要がないのでしょうか?
>>[Ctrl]+[*]キーで取得できるデータ範囲でOKですか?
>当方、海外勤務で英語バージョンのWindowsを使っていますが"No outline exists." "Cannot create outline."と表示されてしまいます。
英語版と日本語版でショートカットキーが異なるみたいですね。では、データのあるシートを選択した状態で、下記コードを実行してみて下さい。
Sub SelectDataArea()
Range("A1").CurrentRegion.Select
End Sub
これで、処理の対象としたいセルが全て選択されていますか?
>3.できればフォントがArialが希望です。
わかりました。しかし、一番知りたいのは、罫線やフォントの色なども複写する必要があるのかどうかです。つまり、書式を含めたセルごとコピーしなければならないのか、値のみ転記できればよいのかの違いです。
No.8
- 回答日時:
前提 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 1行目からデータ>1行目が見出し行があるなら修正する
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 分岐にて処理可
回答が遅くなりましてすみません。出張など重なり、忙殺されて本番データを使ってテストする時間がなかなか見つかりませんでした。すみません。最後にいただいたPGMを使ったテストの結果は完璧でした。本当にありがとうございました。結果を見て感動を覚えました。心より御礼申し上げます。
No.7
- 回答日時:
こんにちは。
>..マクロやプログラムはまだ一切組めていません。
丸なげはどうかと思いますが、自分の勉強も兼ねてコードを書いてみました。しかし、非常に長く、冗長で、きたないコードです。
それでも宜しければアップしますが、もうこのスレッドは読んでいらっしゃいませんか?
もし、コードのアップを御希望される場合は、下記の補足をお願いします。
1. データはA1セルから始まり、データの終わりまでに空白行はありませんか?
-->[Ctrl]+[*]キーで取得できるデータ範囲でOKですか?
2. 見出し行はありますか?
3. 転記は値のみで、セル書式は考慮しなくても良いですか?
4. 「ハイライト」とはセルに背景色を設定するという意味?
5. 新旧データの比較は大小・全半角などを区別する必要は?
この回答への補足
いつもアドバイスありがとうございます。他の過去ログを拝見したりしながらマクロを組んでみるも動かず、経験がないのでUpできるような代物にならず終いです。
早速ですがご質問に回答させていただきます。
1.全く空白の行はありませんが、キーとなる列に空白のセルが存在します。
>[Ctrl]+[*]キーで取得できるデータ範囲でOKですか?
当方、海外勤務で英語バージョンのWindowsを使っていますが"No outline exists." "Cannot create outline."と表示されてしまいます。
2.見出し行は一行あります。
3.できればフォントがArialが希望です。
4.ハイライトとは追加・変更のあるセルだけではなくて、その行全体のセルに背景色をつけるという意味です。
5.新旧データの比較で大小・全半角を区別する必要はありません。
以上、回答させていただきます。お手数で大変恐縮ですが何卒宜しくお願いいたします。
No.6
- 回答日時:
「マッチングマクロ高速版Ver6.1」(6,800円)
のページがあったので添付します。
参考URL:http://www.vector.co.jp/soft/win95/business/se28 …
この回答への補足
ありがとうございます。先日、教わった「ベリファイエクセル」を諦めずに何度もトライしていましたが、どうやら症状は、二つのシートを比較して、内容の異なるセルを見つけたら、新しいシートを自動的に作り、該当位置のセルをハイライトするところまでは問題ないことが分かりました。但し、そのセルはハイライトされるだけで中身は空白のままで、結果は何もないシートにぽつぽつと赤いセルが現れるだけなのです。私の期待している結果は新旧二つのシートを比べて古いシートの内容を新しい内容で書き換えることですので、新しいシートの中身もそのハイライトされたセルに載って欲しいのですが・・・。もし、これができれば「ベリファイエクセル」で十分です。
補足日時:2005/02/15 05:06No.5
- 回答日時:
#4です。
>EXCEL2003です。最新バージョンなのですが。
それだと出来るはずですよね。
ダウンロード中に不具合が出るのかもしれませんね。
お金がかかってもよいなら、次の本にも当ソフトが
入っていますので試してみてください。
成美堂出版
SEIBIDO MOOK「使えるEXCELフリー&シェアソフト厳選360 2005年版」(CD-ROM版) 998円
この本は1月中旬頃からコンビニ等で販売されてたものです。コンビニにはもう無くとも本屋にはあると思います。
この本の41ページ、42ページに「比較・抽出・置換ソフト」が6本紹介されています。
お金を気にしなければシェアウェアの「マッチングマクロ高速版Ver6.1」というのが一番使えるかもしれません。
「マッチングマクロ高速版Ver6.1」(6,800円)
データを指定したキーでマッチングさせて転送できる。
複数のキーや未ソートデータ、別シート・ブック間での
処理にも対応。
VLOOKUP関数での機能をより使いやすく充実させたマクロ。
製作者:EC研究所
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルについて教えてください。 3 2023/06/28 09:11
- Excel(エクセル) Excelマクロ 差分抽出の方法が知りたいです。 2 2023/03/07 13:25
- Excel(エクセル) Excelでのデータ管理 6 2022/12/24 09:33
- Visual Basic(VBA) Excel VBA 最終行を取得しVlookup関数をコピーする方法をコーディングで教えてください。 3 2023/05/11 13:14
- Visual Basic(VBA) 複数指定セルの可視セルのみを別シートに転記するVBAについて 2 2022/05/27 21:19
- Visual Basic(VBA) エクセルのマクロで対象ごとにシート分けしてその内容をセルに書き込みたい 9 2022/08/24 13:23
- Excel(エクセル) マクロVBAのフォルダ階層別で検索の方法 4 2022/04/03 23:23
- Visual Basic(VBA) 複数ファイルのデータの統合について 12 2022/05/14 12:03
- Visual Basic(VBA) 顧客ごとに違う点検案内を作成するマクロ 4 2022/09/16 05:34
- Excel(エクセル) VBA ふたつの同じ様式シートのセルをコピーしたい 2 2023/03/08 15:28
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルファイルのシート毎の容量
-
複数シートからデータを拾って...
-
Excelでシートの違うデータでグ...
-
シート削除して同名シート追加...
-
エクセルのカメラ機能について
-
【エクセル」 特定のセルで条件...
-
エクセルのデータ振り分け方法...
-
Excelで日付変更ごとに、自動的...
-
Excelマクロ 差分抽出の方法が...
-
(VBAにて)日付でデータを抽出す...
-
excelの不要な行の削除ができな...
-
【マクロ】元データを別ファイ...
-
エクセル マクロ "特定の日付...
-
トランジスタの選び方
-
VBAで CTRL+HOMEの位置へ移動...
-
別々のシートの表をピボットテ...
-
1分ごとの数値のマクロ
-
エクセル 縦に長い表の印刷時...
-
【マクロ】同じフォルダ内にあ...
-
エクセルで複数行のデータを1列...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルファイルのシート毎の容量
-
複数シートからデータを拾って...
-
Excelでシートの違うデータでグ...
-
シート削除して同名シート追加...
-
Excelで日付変更ごとに、自動的...
-
excelの不要な行の削除ができな...
-
EXCELで2つのファイルから重複...
-
トランジスタの選び方
-
VBAで CTRL+HOMEの位置へ移動...
-
別々のシートの表をピボットテ...
-
Googleスプレッドシートフィル...
-
EXCEL 複数行のデータを1行にま...
-
他のシートの一番下の行データ...
-
エクセルで名簿を50音で切り分ける
-
(VBAにて)日付でデータを抽出す...
-
エクセルのデータ振り分け方法...
-
EXCEL の表を一行ずつシートに...
-
エクセル VBA VLOOKUP
-
【エクセル」 特定のセルで条件...
-
エクセルのカメラ機能について
おすすめ情報