お世話になります。関数(Vlookup)では処理(手間)に時間がかかり、マクロ(書籍やマクロの記録など)は知識不足で作る事ができませんでした。恐れ入りますが下記の内容でExcelマクロの作り方をご教示いただきたいです。マクロを勉強し始めようとしているため、全くの初心者です。お手数ですがマクロ自体の処理内容もコメント記述していただけると非常にありがたいです。
【内容】
ファイルAのA列(商品番号)をファイルBとCとDの3つのファイルから検索して合致したファイル(BかCかD)のC列とD列の値をファイルAのC列とD列へ反映したい。
ファイルB~DのC列とD列の値は、不定期に更新される。
【詳細】
(1)マクロでファイルB・C・Dを開く。
(2)ファイルAのC列とD列の空白部分へファイルB・C・DのC列とD列の値を反映。
【条件】(2)の反映をする際に、ファイルAのE列が「書籍」で、F列が「1」の場合、ファイルDのC列とD列の値を反映したい。(理由は、ファイルCとDには、同じ商品番号が存在することがあるので)
(3)あと、既に入力されているファイルAのC列とD列の値が、ファイルB~Dの
値と不一致の場合、別シートへ不一致の商品番号をリストアップしたい。
可能であれば、どの様に値が違うかも表示させたい。
表示例、本文の最下部の「不一致シート」の様な形で。
※不一致シートへ表示させるだけで、上書きをしない様にしたい。
■ファイルAのファイル名: 管理ファイル
■ファイルAのシート名: 管理シート
商品番号 商品名 棚番号 棚段数 種類 中古フラグ
G-1111 A 600 8 書籍
G-2222 B 書籍
G-3333 C 1122 書籍
G-6666 R 部品
G-8888 S 書籍
G-S9S9 000S 書籍 1
G-4444 K 6008 部品
G-YYYY GHJK 書籍 1
G-ASDF TT 部品
G-7K9P MKM 5004 部品
G-4RFV 8LO 書籍 1
G-7UJM ZXCV 1122 書籍 1
G-2525 25JJ 1193 書籍
G-VVVV V 部品
G-CGCG 85F0 1055 部品
G-3636 S234 部品
■ファイルBのファイル名: バイク部門ファイル
■ファイルBのシート名: バイク部門シート
商品番号 商品名 棚番号 棚段数
G-4444 K 600 8
G-6666 R 100 9
G-3636 S234 112 2
G-VVVV V
G-CGCG P520 105 5
G-ASDF TT
G-7K9P MKM 500 4
■ファイルCのファイル名: 車部門ファイル
■ファイルCのシート名: 車部門シート
商品番号 商品名 棚番号 棚段数
G-1111 A 600 8
G-2222 B
G-3333 C 112 2
G-8888 S 105 5
G-2525 25JJ 119 3
G-7UJM ZXCV
G-YYYY GHJK 200 1
■ファイルDのファイル名: 車(トラック含)部門ファイル
■ファイルDのシート名: 車(トラック含)部門シート
商品番号 商品名 棚番号 棚段数
G-S9S9 000S 600 8
G-4RFV 8LO
G-7UJM ZXCV 112 2
G-YYYY GHJK 200 1
■ファイルAのファイル名: 管理ファイル
■ファイルAのシート名: 不一致シート
商品番号 棚番号(既存) 棚段数(既存) 棚番号(不一致) 棚段数(不一致)
G-???? 600 8 700 3
G-???1 100 1 200 6
以上です。宜しくお願い致します
No.1ベストアンサー
- 回答日時:
ファイルは全て同じフォルダに有るものとする。
C列とD列両方とも空白のときのみ変更する。
ファイル名は次のとおりです。
バイク部門ファイル.xls 車部門ファイル.xls 車(トラック含)部門ファイル.xls
シート名は次のとおりです。
管理 バイク部門 車部門 車トラック含部門 不一致
このマクロは、管理ファイルに書いてある。
E列が「書籍」で、F列が「1」の場合、前の値と違うときは、不一致に書き出すとともに
C列とD列両方とも空白でないときも、管理を書き換えています。
管理ファイルの中で、商品番号のダブりは無いものとします。
管理ファイルにない商品番号はない!として処理しています。
違うときは、補足願います。
Sub 値の転記()
Dim 配列 As Variant
Dim 不一致(1 To 1000, 1 To 6) As Variant '不一致は1000行まで確保
Dim i As Long, j As Long, k As Long
Dim Gyo As Long
Dim myDic As Object
Set myDic = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("管理")
配列 = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
For i = 1 To UBound(配列)
myDic.Add 配列(i, 1), i
Next
End With
On Error Resume Next
Workbooks("バイク部門ファイル.xls").Activate
If Err.Number <> 0 Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "バイク部門ファイル.xls"
End If
On Error GoTo 0
With Workbooks("バイク部門ファイル.xls").Sheets("バイク部門")
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
j = myDic.Item(.Range("A" & i).Value)
If 配列(j, 3) = "" And 配列(j, 4) = "" Then
配列(j, 3) = .Range("C" & i).Value
配列(j, 4) = .Range("D" & i).Value
Else
If 配列(j, 3) <> .Range("C" & i).Value Or _
配列(j, 4) <> .Range("D" & i).Value Then
Gyo = Gyo + 1
不一致(Gyo, 1) = 配列(j, 1)
不一致(Gyo, 2) = 配列(j, 3)
不一致(Gyo, 3) = 配列(j, 4)
不一致(Gyo, 4) = .Range("C" & i).Value
不一致(Gyo, 5) = .Range("D" & i).Value
不一致(Gyo, 6) = "バイク部門"
End If
End If
Next i
End With
以下次の回答で
No.3
- 回答日時:
続き 3
On Error Resume Next
Workbooks("車(トラック含)部門ファイル.xls").Activate
If Err.Number <> 0 Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "車(トラック含)部門ファイル.xls"
End If
On Error GoTo 0
With Workbooks("車(トラック含)部門ファイル.xls").Sheets("車トラック含部門")
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
j = myDic.Item(.Range("A" & i).Value)
If 配列(j, 3) = "" And 配列(j, 4) = "" Then
配列(j, 3) = .Range("C" & i).Value
配列(j, 4) = .Range("D" & i).Value
Else
If 配列(j, 3) <> .Range("C" & i).Value Or _
配列(j, 4) <> .Range("D" & i).Value Then
Gyo = Gyo + 1
不一致(Gyo, 1) = 配列(j, 1)
不一致(Gyo, 2) = 配列(j, 3)
不一致(Gyo, 3) = 配列(j, 4)
不一致(Gyo, 4) = .Range("C" & i).Value
不一致(Gyo, 5) = .Range("D" & i).Value
不一致(Gyo, 6) = "トラック含"
End If
If 配列(j, 5) = "書籍" And 配列(j, 6) = 1 Then
配列(j, 3) = .Range("C" & i).Value
配列(j, 4) = .Range("D" & i).Value
End If
End If
Next i
End With
With ThisWorkbook
.Sheets("管理").Range("A2", .Sheets("管理").Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value = 配列
.Sheets("不一致").Range("A2:F1001").ClearContents
.Sheets("不一致").Range("A2", .Sheets("不一致").Range("F" & Gyo + 1)).Value = 不一致
End With
Set myDic = Nothing
End Sub
この回答への補足
ki-aaa様
ご教示いただきありがとう御座いました。
無事、実施したい事ができました。本当に感謝致します。
ご質問させていただきたいのですが、「管理シート」の「棚番号」と「棚段数」の列を移動したくて、下記のマクロの部分で、移動先の列番号に変更しました。
しかし、「棚番号」の列には反映されましたが、「棚段数」の列は全く反映されず空白のままになります。。
※「棚番号」は、5列目(E列)へ移動し、「棚段数」は、8列目(H列)へ移動したい。
※下記マクロの箇所が3回続くので、全て列番号は変更しました。
If 配列(j, 5) = "" And 配列(j, 8) = "" Then
配列(j, 5) = .Range("C" & i).Value
配列(j, 8) = .Range("D" & i).Value
Else
If 配列(j, 5) <> .Range("C" & i).Value Or _
配列(j, 8) <> .Range("D" & i).Value Then
Gyo = Gyo + 1
不一致(Gyo, 1) = 配列(j, 1)
不一致(Gyo, 2) = 配列(j, 5)
不一致(Gyo, 3) = 配列(j, 5)
不一致(Gyo, 4) = .Range("C" & i).Value
不一致(Gyo, 5) = .Range("D" & i).Value
不一致(Gyo, 6) = "バイク部門"
End If
他の部署の依頼により今後も「棚番号」と「棚段数」の列を移動させる可能性がございます。
恐れ入りますが、移動させる場合のマクロの変更箇所と変更した箇所のマクロの意味をお教え頂けないでしょうか。
御手数おかけしており大変恐縮ですが、何卒、宜しくお願い致します。
No.2
- 回答日時:
続き 2
On Error Resume Next
Workbooks("車部門ファイル.xls").Activate
If Err.Number <> 0 Then
Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "車部門ファイル.xls"
End If
On Error GoTo 0
With Workbooks("車部門ファイル.xls").Sheets("車部門")
For i = 2 To .Range("A" & Rows.Count).End(xlUp).Row
j = myDic.Item(.Range("A" & i).Value)
If 配列(j, 3) = "" And 配列(j, 4) = "" Then
配列(j, 3) = .Range("C" & i).Value
配列(j, 4) = .Range("D" & i).Value
Else
If 配列(j, 3) <> .Range("C" & i).Value Or _
配列(j, 4) <> .Range("D" & i).Value Then
Gyo = Gyo + 1
不一致(Gyo, 1) = 配列(j, 1)
不一致(Gyo, 2) = 配列(j, 3)
不一致(Gyo, 3) = 配列(j, 4)
不一致(Gyo, 4) = .Range("C" & i).Value
不一致(Gyo, 5) = .Range("D" & i).Value
不一致(Gyo, 6) = "車部門"
End If
End If
Next i
End With
ki-aaa様
ご教授いただきありがとう御座いました。
不明点が多く戸惑ってばかりですが、
もっとマクロを勉強するように致します。
御手数おかけしました。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
配列数式の解除
-
VBA 1次元配列を2次元に追加する
-
【MATLAB】任意の多次元配列か...
-
VBAで近似曲線の係数取得
-
subの配列引数をoptionalで使う...
-
特定のセル範囲で4文字以上入力...
-
配列に同じ値を入れる方法
-
VBAで配列をまるごとコピー
-
2次元動的配列の第一引数のみを...
-
AES暗号にて、AES_set_encrypt_...
-
CGIでカスタム配列でソート
-
for each の現在の配列ポインタ...
-
エクセルで最小値から0を除く方法
-
配列数式って何ですか??
-
fortran 渡す値について
-
OutlookVBAでサブフォルダ一括作成
-
[Excel2000_VBA] 型が一致しま...
-
Excel-VBAの配列「Public Const...
-
テキストボックスの表示
-
2つ以上の変数を比較して最大数...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
配列数式の解除
-
2つ以上の変数を比較して最大数...
-
VBA 1次元配列を2次元に追加する
-
VB6 配列を初期化したい
-
特定のセル範囲で4文字以上入力...
-
ListViewで、非表示列って作れ...
-
《エクセル2000》A列・B列の商...
-
配列変数の添字が範囲外ですと...
-
Excel-VBAの配列「Public Const...
-
subの配列引数をoptionalで使う...
-
for each の現在の配列ポインタ...
-
配列を任意の数値で埋める方法
-
Dim は何の略ですか?
-
VBのFunctionで、配列を引数...
-
配列内の内容を全て表示する方法
-
2次元動的配列の第一引数のみを...
-
Excel VBA配列をFunctionに渡す
-
VBA Match関数の限界
-
Array配列の末尾に追加したい。
-
AES暗号にて、AES_set_encrypt_...
おすすめ情報