[[20110726085332]]　『複数のリストの内容を引当て（照合）して、片方の』（ｔｔ）　ページの最後に飛ぶ

『複数のリストの内容を引当て（照合）して、片方のリストだけにデータ入力をしたい』（ｔｔ）

はじめて質問します。エクセル初心者です。基礎の関数（ＩＦやＣＯＵＮＴ、ＯＲ、ＡＮＤなど）の使い方が理解できる程度です。
職場で備品管理の仕事をしており、備品リストの照合作業をしています。

備品リストは全社分と部署分があり（別ブック）、全社分の備品リストには部署分の備品も含まれています。なお、すべての備品には共通の通し番号がふられています。

しかし、全社備品リストの方に「どの部署のリストにその備品が登録されてのか」という点が記載されておらず、大変使いにくくなってしまっています。

そこで、部署分備品リストの番号と全社備品リストを番号をもとに引当して、全社分備品リストの項目に部署名を入力したいのですが、何か良い方法はないでしょうか。（ちなみに部署の数は５つです。）

また、もう少し複雑になるのですが、部署分の備品リストにある備品ごとの備考欄の情報を、全社の備品リストの備品の備考欄にもコピーするすることはできるでしょうか。

なお、備品リストの管理方法の関係上、部署のリストと全社のリストを同じブック上に置いたり、一つのシート上にまとめるのはできません。ＥＸＣＥＬ２００７です。

どなたか良いお知恵をお貸しください。

 >はじめて質問します。エクセル初心者です。
 との事なので、回答が付きにくい理由を書いてみます。

 たぶん、やりたい事はＶＢＡで簡単にできる内容だと思いますが
 情報が足りなさすぎます。

 回答者の方が最低限同じ状況を作られるだけの情報が必要です。

 リストのレイアウトやサンプルデータ、求める結果のレイアウト
 計６つ（？）のブック名やパス
 部署名はどこでわかるのか
 複数の部署に登録されている場合はどう記述するのか

 など、少なくとも私の前には真っ白なセルのエクセルさんしか居ない状態で
 ttさんの文章を読んだだけでは何一つセルが埋まらないので回答が難しいです。

 （ｍｏｍｏ）

（ｔｔ）

Momoさん、そうですね、ありがとうございます。

どちらのリストとも、まずＡ列に備品番号、Bに備品名、他のデータときて…最終のF列に備考欄があります。縦方向は１列目のみ項目名で、あとはすべて個別の備品データです。
ブック名は「全社備品リスト」「総務部備品リスト」です。ほかは権限上触れません。

求める結果は全社リストのG列に記述できれば、と思います。

同じ備品が複数の部署に登録されていることはありません。

部署名が分かる箇所は現在のデータ上にはありません。（VLOOKUPなどを使って全社リストに部署名を記述するとしたら、元にする部署別備品リストにG列を足して「総務部」などと書き加ればいいのかな…などと思っています）

わかりにくくて済みません。

 マクロで作りました。

 Option Explicit
 Sub Sample()

    Dim AllEQPath As String
    Dim AllEQSht As String
    Dim maxRow As Long
    Dim FCell As Range
    Dim i As Long
    Dim DtStr As String

    AllEQPath = "C:\Documents and Settings\YAMADA_TARO\デスクトップ\全社備品リスト.xls"
    AllEQSht = "Sheet1"

    Application.ScreenUpdating = False
    Workbooks.Open AllEQPath
    ThisWorkbook.Activate
    maxRow = Range("A1").End(xlDown).Row

    With Workbooks(Dir(AllEQPath)).Sheets(AllEQSht)
        For i = 2 To maxRow
            DtStr = Cells(i, "A")
            Set FCell = .Columns("A").Find(what:=DtStr)
            If FCell Is Nothing Then
                MsgBox DtStr & " が全社リストに見つかりません", vbCritical
            Else
                .Cells(FCell.Row, "G") = ThisWorkbook.Name
                .Cells(FCell.Row, "F") = Cells(i, "F").Value
            End If
        Next i
    End With
    Application.ScreenUpdating = True

    MsgBox "完了しました"

 End Sub

 "総務部備品リスト.xls"を開いて、
 [Alt]+[F11]でVBEを起動。メニューバーより[挿入]-[標準モジュール]を選択し、
 右側の大きな空白部分に上記コードを貼り付け。VBEを右上「×」で閉じて、
 実行は[Alt]+[F8]でSampleを選択して実行。

 想像しながらの作成ですので、抜けてる箇所があるかもです。。

 (Yujin)

 書いてる間に先を越されてしまいましたが折角なのでＵＰ

 とりあえず叩き台としてサンプルを書いてみました

 テスト用に全社備品リストのファイルをコピーして
 コピーした全社備品リストのシートにフォームのボタンを配置して
 マクロの登録で新規作成、表示された画面の
 Sub ボタン1_Click()
 と
 End Sub
 の間に以下のコードを張り付けてVBEの画面は閉じる

  Dim myPath As String
  Dim myPost As String
  Dim i      As Long
  Dim j      As Long
  Dim tbl    As Variant
  myPath = Application.GetOpenFilename("備品リストファイル(*.xls),*.xls")
  If myPath Like "*\*部備品リスト.xls" Then
    myPost = StrReverse(Split(StrReverse(Replace(myPath, "備品リスト.xls", "")), "\")(0))
    Application.ScreenUpdating = False
    With Workbooks.Open(myPath)
      tbl = .Worksheets(1).Range("A1").CurrentRegion.Value
      .Close False
    End With
    With ThisWorkbook.Worksheets(1)
      For i = 2 To UBound(tbl, 1)
        If Application.WorksheetFunction.CountIf(.Columns(1), tbl(i, 1)) = 1 Then
          j = Application.WorksheetFunction.Match(tbl(i, 1), .Columns(1), 0)
          .Cells(j, 6).Value = tbl(i, 6)
          .Cells(j, 7).Value = myPost
        End If
      Next i
    End With
    Application.ScreenUpdating = True
  End If

 で、ボタンを押して部署別の備品リストファイルを選んでください。
 １回に１部署のファイルを読み込んで処理します。
 適宜部署ごとに読み込んでみてください。
 （ｍｏｍｏ）

コメント返信：

[ 一覧(最新更新順) ]

[[20110726085332]] 『複数のリストの内容を引当て（照合）して、片方の』（ｔｔ） ページの最後に飛ぶ

[[20110726085332]]　『複数のリストの内容を引当て（照合）して、片方の』（ｔｔ）　ページの最後に飛ぶ