プロが教えるわが家の防犯対策術!

お世話になります。関数(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

以上です。宜しくお願い致します

A 回答 (3件)

ファイルは全て同じフォルダに有るものとする。


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

以下次の回答で
    • good
    • 0

続き 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
    • good
    • 0
この回答へのお礼

ki-aaa様

ご教授いただきありがとう御座いました。
不明点が多く戸惑ってばかりですが、
もっとマクロを勉強するように致します。

御手数おかけしました。

お礼日時:2011/05/08 22:58

続き 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


他の部署の依頼により今後も「棚番号」と「棚段数」の列を移動させる可能性がございます。
恐れ入りますが、移動させる場合のマクロの変更箇所と変更した箇所のマクロの意味をお教え頂けないでしょうか。

御手数おかけしており大変恐縮ですが、何卒、宜しくお願い致します。

補足日時:2011/04/17 14:55
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!