Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


2365 / 13645 ツリー ←次へ | 前へ→

【68149】VLOOKUPを使ったデータの参照 ケメ子 11/2/7(月) 0:02 質問[未読]
【68152】Re:VLOOKUPを使ったデータの参照 UO3 11/2/7(月) 11:14 発言[未読]
【68162】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/7(月) 22:43 発言[未読]
【68164】Re:VLOOKUPを使ったデータの参照 UO3 11/2/8(火) 12:45 発言[未読]
【68173】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/8(火) 22:04 発言[未読]
【68174】Re:VLOOKUPを使ったデータの参照 UO3 11/2/9(水) 11:43 発言[未読]
【68175】Re:VLOOKUPを使ったデータの参照 UO3 11/2/9(水) 12:12 発言[未読]
【68176】Re:VLOOKUPを使ったデータの参照 UO3 11/2/9(水) 12:25 発言[未読]
【68177】Re:VLOOKUPを使ったデータの参照 UO3 11/2/9(水) 13:09 発言[未読]
【68180】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/9(水) 22:11 発言[未読]
【68182】Re:VLOOKUPを使ったデータの参照 UO3 11/2/10(木) 12:26 回答[未読]
【68183】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/10(木) 23:35 発言[未読]
【68232】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/16(水) 23:15 質問[未読]
【68237】Re:VLOOKUPを使ったデータの参照 UO3 11/2/17(木) 10:29 回答[未読]
【68240】Re:VLOOKUPを使ったデータの参照 UO3 11/2/17(木) 10:43 発言[未読]
【68243】Re:VLOOKUPを使ったデータの参照 UO3 11/2/17(木) 11:02 回答[未読]
【68254】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/17(木) 22:39 発言[未読]
【68255】Re:VLOOKUPを使ったデータの参照 UO3 11/2/17(木) 23:08 発言[未読]
【68259】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/18(金) 21:14 発言[未読]
【68303】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/22(火) 0:44 質問[未読]
【68306】Re:VLOOKUPを使ったデータの参照 UO3 11/2/22(火) 9:28 発言[未読]
【68307】Re:VLOOKUPを使ったデータの参照 UO3 11/2/22(火) 9:50 発言[未読]
【68308】Re:VLOOKUPを使ったデータの参照 UO3 11/2/22(火) 10:27 発言[未読]
【68314】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/23(水) 0:19 発言[未読]
【68315】Re:VLOOKUPを使ったデータの参照 UO3 11/2/23(水) 13:32 発言[未読]
【68316】Re:VLOOKUPを使ったデータの参照 UO3 11/2/23(水) 13:36 発言[未読]
【68317】Re:VLOOKUPを使ったデータの参照 UO3 11/2/23(水) 13:38 回答[未読]
【68321】Re:VLOOKUPを使ったデータの参照 UO3 11/2/23(水) 22:04 発言[未読]
【68322】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/23(水) 22:04 質問[未読]
【68331】Re:VLOOKUPを使ったデータの参照 UO3 11/2/24(木) 11:46 発言[未読]
【68333】Re:VLOOKUPを使ったデータの参照 UO3 11/2/24(木) 11:47 発言[未読]
【68346】Re:VLOOKUPを使ったデータの参照 ケメ子 11/2/24(木) 22:46 発言[未読]
【68421】Re:VLOOKUPを使ったデータの参照2 ケメ子 11/3/3(木) 20:15 質問[未読]
【68425】Re:VLOOKUPを使ったデータの参照2 UO3 11/3/4(金) 12:32 回答[未読]
【68426】できました!! ですが・・・ ケメ子 11/3/4(金) 20:31 質問[未読]
【68429】Re:できました!! ですが・・・ UO3 11/3/4(金) 21:51 発言[未読]
【68431】Re:できました!! ですが・・・ UO3 11/3/5(土) 16:58 回答[未読]
【68432】Re:できました!! ですが・・・ ケメ子 11/3/5(土) 18:53 発言[未読]
【68441】プロシージャの追加場所 ケメ子 11/3/7(月) 21:21 質問[未読]
【68442】Re:プロシージャの追加場所 UO3 11/3/7(月) 21:59 回答[未読]
【68479】\(^o^)/ ケメ子 11/3/9(水) 20:58 お礼[未読]

【68149】VLOOKUPを使ったデータの参照
質問  ケメ子  - 11/2/7(月) 0:02 -

引用なし
パスワード
   よろしくお願いいたします。

以前、作業用データのセル範囲を、ファイル名が同じパスワード付のファイルの指定した箇所へコピーするという質問をさせていただきましたが、このたびこちらを応用して、VLOOKUPの式を組みたいと考えております。

まず、現在のマクロの内容は以下の通りです。

<詳細>
作業用データ(ファイル名は【作業】xxxxxxxxx(xは数字の桁)で始まる顧客名)のA,B,C,Dの4つのシートそれぞれからデータをコピーし、作業用のデータと同じ数字9ケタ+顧客名の提出用ファイル(ファイル名は、作業用データの【作業】を省いたxxxxxxxxxで始まる顧客名)のA,B,C,Dシートそれぞれの指定した箇所に値貼り付けする。

というもので、以下のようなコードが入っています。

*********************************

Option Explicit

Sub Sample3()
  Dim fPath As String  '元ブックのサーバパス
  Dim tPath As String  '先ブックのサーバパス
  Dim z As Long
  Dim shn As Variant
  Dim myFso As Object
  Dim myFiles As Object
  Dim myFile As Object
  Dim tCell As String
  Dim fName As String
  Dim fBook As Workbook
  Dim tBook As Workbook
  Dim xlRowMax As Long
  
  Application.ScreenUpdating = False
  Set myFso = CreateObject("Scripting.FileSystemObject")

  fPath = "c:\Test1"  '実際のサーバパス名に
  tPath = "c:\Test2"  '実際のサーバパス名に
  xlRowMax = Rows.Count
  
  For Each myFile In myFso.GetFolder(tPath).Files
    fName = "【作業】" & myFile.Name
    If LCase(myFso.GetExtensionName(myFile.Name)) = "xls" And _
              myFso.FileExists(fPath & "\" & fName) Then
      Set fBook = Workbooks.Open(fPath & "\" & fName)
      Set tBook = Workbooks.Open(tPath & "\" & myFile.Name, Password:="abc")
      For Each shn In Array("A", "B", "C", "D")
 
        Select Case shn
          Case "A"
            tCell = "P5"
          Case "B"
            tCell = "C5"
          Case "C"
            tCell = "V5"
          Case "D"
            tCell = "N5"
        End Select
        With tBook.Worksheets(shn)
          .Range(tCell & ":" & Split(.Range(tCell).Address, "$")(1) & xlRowMax).ClearContents
          z = fBook.Sheets(shn).Range("G" & xlRowMax).End(xlUp).Row
          If z >= 6 Then
            .Range(tCell).Resize(z - 5).Value = _
                  fBook.Sheets(shn).Range("G6").Resize(z - 5).Value
          End If
        End With
      Next
 
      tBook.Close True
      fBook.Close False
 
    End If
  Next

  Set myFso = Nothing
  Set fBook = Nothing
  Set tBook = Nothing
  Application.ScreenUpdating = True

  MsgBox "処理が終了しました。"

*********************************

こちらを応用して、「作業用データを作るための処理」を行うにあたり、VLOOKUP式やDO LOOP〜などを使った記述を行いたいのですが、どの部分に記述すればよいか分からず、ご教示願えればと思います。

具体的にやりたい内容は以下の通りです。

1.作業用データには、VLOOKUP関数を使って項目ごとのランクが求められている。
 (検索値の番号列があります。)

 この参照元のデータは「前月度の作業用データ」で、前月度のA,B,C,Dのそれぞ
 れのシートから、今月度の同じ名前のシート名のところに参照し、前月度にあっ
 て、今月度にもあった項目には、前月のランクがそのまま参照され、前月度には
 なかった項目には、わざと「#N/A」を表示させたい。

2.A,B,C,Dシートの項目数はシートによって変わる。また前月と今月でも項目数が変わる。

3.VLOOKUPで参照した後は、結果を値貼り付けにしておきたい。

以上になります。
分かりにくい説明で恐縮ですが、なにとぞよろしくお願いいたします。

【68152】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/7(月) 11:14 -

引用なし
パスワード
   ▼ケメ子 さん:

>分かりにくい説明で恐縮ですが、なにとぞよろしくお願いいたします。

は、ちょっとわかりにくいですね。

1.前回は【作業】xxxxxx ブックのシートのG6から始まるG列の値を
  xxxxxx ブックの P5,C5.V5,N5から始まる、その列にコピーする
  ということだったのですが、今回は、【作業】xxxxxx を生成するために
  この、【作業】xxxxxx の「前月」のブックを雛形にしたいということは
  わかりました。
2.その先がわかりません。
 1)前月のデータは、今月のデータとは異なるフォルダに入っており
   それを元に、今月用のフォルダに「新規ブック」をして生成する
   ということでいいのですか?
 2)で、その、【作業】xxxxxx のレイアウトというか、項目って具体的に
   何で、それごとのランクって具体的になんでしょう?
   (イメージがクリアにならないんです)
 3)「検索」というのは、「何」で「何」を検索するんでしょうか?
 4)その検索のための番号列って、具体的に、「どこにあって」「どんな値」が
   入っているのでしょうか?具体例で教えていただけると、皆さん考えやすいと
   思います。

【68162】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/7(月) 22:43 -

引用なし
パスワード
   UO3さま

ケメ子です。
その節は大変お世話になりました。
本当にありがとうございました。

確かに分かりにくいですよね。大変申し訳ございません。
業務工程を精査したところ、若干手順が変わりましたので、詳細をお知らせします。

<業務の概要>

各証券会社の銘柄のレーデイング格付け一覧表をとりまとめる。

<使用フォルダ・ファイル名>

 ・今月度の作業用データ・・・「今月度」フォルダ/ファイル名:【作業】xxxxxxxxx(数字9ケタ)→格付けランクの貼り付け先ファイル

 ・前月度の提出用データ・・・「前月度提出用」フォルダ/ファイル名:xxxxxxxxx(数字9ケタ。今月度の作業用データファイル名の「【作業用】」を省いたもの)→前月度の格付けランクが入っているファイル

 ・情報元データ・・・「元データ」フォルダ/ファイル名:xxxxxxxxx(数字9ケタ。「前月度の提出用データ」と同じファイル名)
→「証券銘柄名」「証券銘柄コード」「Keyコード」などの情報が入ったファイル

各フォルダには、約50ほどのファイルがあり、9ケタの数字は3つのフォルダで使われています。
また、3つのフォルダ内のファイルには、同名のシート「A」「B」「C」「D」の4シートがあり、同じ名前のシート同士でデータの転記を行います。


<作業の流れ>

1.「元データ」フォルダのファイル内4シートそれぞれの「証券銘柄名」「証券銘柄コード」「Keyコード」をコピーする

 シート「A」のセル範囲→C16:E列データ最終行
 シート「B」のセル範囲→F16:H列データ最終行
 シート「C」のセル範囲→M16:O列データ最終行
 シート「D」のセル範囲→E16:G列データ最終行

2.「今月度」フォルダの作業データ内4シートそれぞれのB6、C6、D6を先頭に下方向値貼り付け

3.「今月度」フォルダの作業データ内4シートそれぞれのE6(格付けを入れるフィールド)を先頭に、「前月度提出用」フォルダの提出用データ内4シートに入っている「格付け」をVLOOKUPで参照。

 ※ VLOOKUPの検索値は、「Keyコード」フィールドで、数字のみの5ケタが入っています。
 ※ 提出用データの格付けが入っている先頭位置は以下の通りです。
 シート「A」→P16
 シート「B」→O16
 シート「C」→V16
 シート「D」→N16

また、前月と同じ「Keyコード」があった場合は、前月の格付けをそのまま表示し、前月にないコードは「#N/A」を表示するようにします。

4. 3.で参照したVLOOKUPの結果を値貼り付けしなおす

5.「今月度」フォルダ内のファイル各4シートにあるF〜I列の6行目のみに空白などを処理した式が入っているのですが、これをデータ最終行までコピー。
さらに、各4シートのA列に連番を振るフィールドが用意されており、自動で付番したい。

以上の操作になります。

実のファイルをご覧にならないことにはイメージが湧きにくいと思いますが、また何かご不明な点がありましたらお知らせいただければと思います。

どうぞよろしくお願いいたします。

【68164】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/8(火) 12:45 -

引用なし
パスワード
   ▼ケメ子 さん:

詳細なご説明、ありがとうございます。
1点。

>3.「今月度」フォルダの作業データ内4シートそれぞれのE6(格付けを入れるフィールド)を先頭に、

ここに(「今月度」フォルダの作業データ内4シートそれぞれのE6から下)
格付デコード用のテーブルが「あらかじめ」記入されているということでしょうか?
で、その場合、コードがE列だとして、デコードすべきものはF列でしょうか?

【68173】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/8(火) 22:04 -

引用なし
パスワード
   UO3さま

本当にありがとうございます。
こちらこそ、説明不足で申し訳ありません。

>>3.「今月度」フォルダの作業データ内4シートそれぞれのE6(格付けを入れるフィールド)を先頭に、
>
>ここに(「今月度」フォルダの作業データ内4シートそれぞれのE6から下)
>格付デコード用のテーブルが「あらかじめ」記入されているということでしょうか?
>で、その場合、コードがE列だとして、デコードすべきものはF列でしょうか?

申し訳ありません。
余計なことを書きましたが、「今月度」フォルダの作業データには、2.の操作によって、D列に「Keyコード」が貼り付けられています。

その「Keyコード」を検索値として、「今月度」フォルダの作業データE列に、前月度提出用データの格付けを参照します。

そしてE列に入れたVLOOKUPの式を外した状態にしたいので、もう一度E列を選択し直しコピー→値貼り付けにしたいと考えております。

したがってF列は、今回は対象となるデータはありません。


ほんとにお手数おかけいたしますが、よろしくお願いいたします。

【68174】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/9(水) 11:43 -

引用なし
パスワード
   ▼ケメ子 さん:

こんにちは

う〜ん・・・理解力が乏しく、まだクリアになりません。
ちょっと「妥協案」
以下に、コードサンプルをアップします。
・BookA.xlsのSheet1の5行目から始まるB列、C列にリストがあります。(B列がキー)
・BookB.xlsのSheet1の5行目から始まるD列にコードがあります。このコードを
 BookA.xlsのリストでVLOOKUPをかけ結果をBookB.xlsの5行目から始まるE列に表示します。

このサンプルをご利用頂き、現在の実際のシートレイアウトにあわせて、ちょっと
がんばってコードを作り、行き詰ったら、それをアップいただけませんか?

Sub Sample()
  Dim tblAddr As String
  Dim z As Long
  
  With Workbooks("BookA.xls").Sheets("Sheet1")
    z = .Range("B" & .Rows.Count).End(xlUp).Row
    If z >= 5 Then
      tblAddr = .Range("B5:C" & z).Address
    End If
  End With
  
  With Workbooks("BookB.xls").Sheets("Sheet1")
    With .Range("D5:D" & .Range("D" & .Rows.Count).End(xlUp).Row).Offset(, 1)
      If z >= 5 Then
        If tblAddr = "" Then
          .Formula = "#N/A" 'すべて#N/A
        Else
          .Formula = "=VLOOKUP(D5,[BookA.xls]Sheet1!" & tblAddr & ",2,FALSE)"
          .Value = .Value
        End If
      End If
    End With
  End With
  
End Sub

【68175】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/9(水) 12:12 -

引用なし
パスワード
   ▼ケメ子 さん:

もしかしたら理解できたかもしれません。

今月のデータにはD列に「Keyコード」がある。
前月のデータにもD列に「Keyコード」がある。
またA,B,C,DシートのP,O,V,N列に「格付けランク」がある。

で、行うことは

今月のKeyコードで前月のKeyコードを検索し、マッチしたら前月の格付けランクを
今月のE列に「値で」セットする。

こんなことでしょうか?

【68176】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/9(水) 12:25 -

引用なし
パスワード
   ▼ケメ子 さん:

でも、まだ1つわからないことが。

今月データも前月データも、データは「6行目」から始まっていたんですよね。
つまり「Keyコード」も6行目からですよね。
一方、格付けランクは6行目からではなく16行目から?

これは正しいですか?
正しいとしたら、マッチした「Keyコード」に対する格付けランクの行は
+10行したところということですか?

【68177】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/9(水) 13:09 -

引用なし
パスワード
   ▼ケメ子 さん:

もしかしたら

 シート「A」のセル範囲→C16:E列データ最終行
 シート「B」のセル範囲→F16:H列データ最終行
 シート「C」のセル範囲→M16:O列データ最終行
 シート「D」のセル範囲→E16:G列データ最終行

とか

 シート「A」→P16
 シート「B」→O16
 シート「C」→V16
 シート「D」→N16

これらは 16 ではなく 6 ですか?

【68180】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/9(水) 22:11 -

引用なし
パスワード
   UO3さま

どうもありがとうございます。
日中はインターネットが見られない場所にいるもので、いつも遅くなって申し訳ございません。

ご質問の件ですが、ややこしくて申し訳ございません。

今回3つのフォルダ内のファイルをやり取りするのですが、そのうち「元データ」と、「前月度提出用データ」はフォームが同じなのですが、「今月度データ」は異なっています。

> シート「A」→P16
> シート「B」→O16
> シート「C」→V16
> シート「D」→N16
>
>これらは 16 ではなく 6 ですか?

実のセル番地は、こちら16になります。

6行目というのは、「元データ」から「証券銘柄名」「証券銘柄コード」「Keyコード」の3項目を、今月データに貼り付ける際の開始行が6行目です。
貼り付け先の列はB〜D列になります。

また16行目というのは、「元データ」の「証券銘柄名」「証券銘柄コード」「Keyコード」が入力されている開始位置が16行目です。

つまり
元データの「証券銘柄名」はC16から始まりますが、貼り付け先の今月データには、B6を先頭に貼り付けることになります。
同様に、「証券銘柄コード」は元データではD16から、今月データにはC6を先頭に貼り付けることになります。

そして「元データ」と「前月度提出用データ」はフォーマットが同じため、「前月度提出用データ」に入っている格付けは、16行目から入っています。

たとえば、シートAならP16から入っていますし、シートBはO16から入っている、という形になっています。

これを先にご説明すればよかったですね、申し訳ございません。


> 今月のデータにはD列に「Keyコード」がある。
> 前月のデータにもD列に「Keyコード」がある。
> またA,B,C,DシートのP,O,V,N列に「格付けランク」がある。

はい。
今月度のD列に「Keyコード」、前月提出用データのD列にKeyコード、P,O,V,N列に格付けランクがあります。

そして、

> 今月のKeyコードで前月のKeyコードを検索し、マッチしたら前月の格付けランクを今月のE列に「値で」セットする。

その通りです。

さらに今月データのF6:I6だけに、別処理をする式が入っていますので、このF6:I6をデータ最終行まで数式コピーする、という記述と、今月データA列にデータ最終行に合わせた連番を振るという記述を加えたいです。

★前回UO3様にご回答いただいたコードをそのまま使用したいと思います。
というのは、ファイル名が前回と同じ規則なので、前回の記述に追加という形で行いたいと思っております。

また、前回のセル番地が若干変わっていますので、上記でご説明したセル番地に置き換えていただければと思います。

これでイメージが少しつかめていただけたら幸いです。

どうぞよろしくお願いいたします。

【68182】Re:VLOOKUPを使ったデータの参照
回答  UO3  - 11/2/10(木) 12:26 -

引用なし
パスワード
   ▼ケメ子 さん:

ようやく飲み込みの悪いUO3も理解できたようです。
(といいながら、まだ誤解していたら指摘してくださいね)

>★前回UO3様にご回答いただいたコードをそのまま使用したいと思います。

ごめんなさい。新しく書きなおしました。
できるだけ前回のコードの【雰囲気】を継承したつもりですのでがまんしてくださいね。

元ファイル、前月度ファイルのファイル名が異なれば一挙に開いて1度のループ処理が
できるのですが、同じ名前ですので、ループ処理を2回行っています。

Option Explicit

Sub Sample作業()
  Dim myFso As Object
  Dim myFiles As Object
  Dim myFile As Object
  Dim shn As Variant  'シート名 A,B,C,D
  Dim z As Long
  Dim xlRowMax As Long 'エクセル最大行数

  '元データ関連
  Dim bPath As String  'サーバパス
  Dim bBook As Workbook 'ブック
  Dim bSh As Worksheet 'シート
  Dim bTop As Long   'データ開始行
  Dim bCol As String  'シートごとのデータ開始列
  Dim bRows As Long   'シートごとのデータ数
  '前月度関連
  Dim oPath As String  'サーバパス
  Dim oBook As Workbook 'ブック
  Dim oSh As Worksheet 'シート
  Dim oTop As Long   'データ開始行
  Dim oCol As String  'シートごとのデータ開始列
  Dim oRows As Long   'シートごとのデータ数
  Dim oName As String  'ブック名。元データも同じ。
  Dim oList As String  'D列から始まるVLOOKUPリスト領域アドレス
  Dim decCol As Long  '同上領域のデコード列番号(1〜)
  '今月度関連
  Dim nPath As String  'サーバパス
  Dim nBook As Workbook 'ブック
  Dim nSh As Worksheet 'シート
  Dim nTop As Long   'データ開始行
  Dim nName As String  'ブック名
  Dim nRank As Object  'ランクデコード領域
  Dim nRows As Long   'シートごとのデータ数
  Dim nBottom As Long  'シートごとのデータ最終行
 
  Application.ScreenUpdating = False
  Set myFso = CreateObject("Scripting.FileSystemObject")

  bPath = "c:\元データ"    '実際のサーバパス名に
  nPath = "c:\今月度"     '実際のサーバパス名に
  oPath = "c:\前月度提出用"  '実際のサーバパス名に
 
  bTop = 16  '元データ開始行
  oTop = 16  '前月度データ開始行
  nTop = 6  '今月度データ開始行
 
  xlRowMax = Rows.Count

  For Each myFile In myFso.GetFolder(nPath).Files
   nName = myFile.Name  '頭に【作業】つき
   oName = Mid(nName, 5) '頭の【作業】を除く
   
   If LCase(myFso.GetExtensionName(nName)) = "xls" And _
      Left(nName, 4) = "【作業】" And _
      myFso.FileExists(bPath & "\" & oName) Then
      
     Set nBook = Workbooks.Open(myFile.Path)
'------------------------------
'元ファイルから各シートへコピー
'------------------------------
     Set bBook = Workbooks.Open(bPath & "\" & oName)
      
     For Each shn In Array("A", "B", "C", "D")
      Select Case shn
        Case "A"
         bCol = "C"
        Case "B"
         bCol = "F"
        Case "C"
         bCol = "M"
        Case "D"
         bCol = "E"
      End Select
      
      Set bSh = bBook.Sheets(shn)
      Set nSh = nBook.Sheets(shn)
      z = bSh.Range(bCol & xlRowMax).End(xlUp).Row
      If z >= bTop Then '元データにデータが存在するときのみ、当シート処理
        bRows = z - bTop + 1
        nBottom = nTop + bRows - 1
        With nSh
         .Range("B6:E" & xlRowMax).ClearContents
         .Range("A6:A" & xlRowMax).ClearContents
         .Range("F7:I" & xlRowMax).ClearContents
         .Range("B6:D6").Resize(bRows).Value = _
              bSh.Range(bCol & bTop).Resize(bRows, 3).Value
         .Range("F" & nTop & ":I" & nBottom).Formula = _
              .Range("F" & nTop & ":I" & nTop).Formula '式をコピー
         .Range("A" & nTop).Value = 1
         .Range("A" & nTop).Resize(bRows).DataSeries '連番
        End With
      End If
     Next
    
     bBook.Close False
    
'----------------------------------------
'前月ファイルから各シートへランクデコード
'----------------------------------------
     Set oBook = Nothing
     If myFso.FileExists(oPath & "\" & oName) Then _
      Set oBook = Workbooks.Open(oPath & "\" & oName)
      
     For Each shn In Array("A", "B", "C", "D")
      Select Case shn
        Case "A"
         oCol = "P"
        Case "B"
         oCol = "O"
        Case "C"
         oCol = "V"
        Case "D"
         oCol = "N"
      End Select
    
      Set nSh = nBook.Sheets(shn)
      z = nSh.Range("D" & xlRowMax).End(xlUp).Row
      If z >= nTop Then 'データが存在するときのみ、当シート処理
        nRows = z - nTop + 1
        With nSh
         Set nRank = .Range("E" & nTop).Resize(nRows)
         If Not oBook Is Nothing Then
           Set oSh = oBook.Sheets(shn)
           z = oSh.Range(oCol & xlRowMax).End(xlUp).Row
           If z >= oTop Then
            oRows = z - oTop + 1
            oList = "[" & oBook.Name & "]" & oSh.Name & "!" & _
                   Range("D" & oTop & ":" & oCol & z).Address
            decCol = Columns(oCol).Column - Columns("D").Column + 1
            nRank.Formula = _
              "=VLOOKUP(D" & nTop & "," & oList & "," & decCol & ",FALSE)"
            nRank.Value = nRank.Value
           Else
            nRank.Formula = "#N/A" '前月ブックの当該シートにデータがない時
           End If
         Else
           nRank.Formula = "#N/A" '前月ブックがない時
         End If
        End With
      End If
     Next
'-------------------------------
'ブック処理完了 --> 次のブックへ
'-------------------------------
     If Not oBook Is Nothing Then oBook.Close False
     nBook.Close True
   End If
  Next
 
  Set nBook = Nothing
  Set oBook = Nothing
  Set bBook = Nothing
  Set nSh = Nothing
  Set oSh = Nothing
  Set bSh = Nothing
  Set nRank = Nothing
  Set myFso = Nothing
 
  Application.ScreenUpdating = True
 
  MsgBox "処理が終了しました。"

End Sub

【68183】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/10(木) 23:35 -

引用なし
パスワード
   UO3 さま

このたびは本当にありがとうございます!
ご親切なコメント付きのコードをお送りいただき、本当に感謝しております。

申し訳ないのですが、実際のデータで確認できるのが月曜日もしくは火曜日になってしまいますので、また様子を週明けにお知らせいたします。
引き続き、どうぞよろしくお願いいたします。

【68232】Re:VLOOKUPを使ったデータの参照
質問  ケメ子  - 11/2/16(水) 23:15 -

引用なし
パスワード
   UO3 さま

ケメ子です。
このたびは、大変お世話になっております。
遅くなりまして、申し訳ございません。

確認してみたところ、一点修正したい点がありました。

>'----------------------------------------
>'前月ファイルから各シートへランクデコード
>'----------------------------------------

のところで、
前月ファイルが、どのシートもKeyコードが「D」列というふうにしておりましたが、大変申し訳ないことに、こちらはシートごとにコードの位置が異なっておりました。

 シート「A」のKeyコード→E列
 シート「B」のKeyコード→H列
 シート「C」のKeyコード→O列
 シート「D」のKeyコード→G列

そこで、以下の部分をCase〜で行おうとしたら「オブジェクト変数またはwithブロック変数が設定されていません。」というエラーが表示されてしまいました。

根本的にCase〜の構文が理解できていないため、どこをどうしたらいいかご教示いただけますでしょうか?
         :
         :
         :
>           If z >= oTop Then
>            oRows = z - oTop + 1
>            oList = "[" & oBook.Name & "]" & oSh.Name & "!" & _
>                   Range("D" & oTop & ":" & oCol & z).Address
>            decCol = Columns(oCol).Column - Columns("D").Column + 1
>            nRank.Formula = _
>              "=VLOOKUP(D" & nTop & "," & oList & "," & decCol & ",FALSE)"
         :
         :
         :


     For Each shn In Array("A", "B", "C", "D")
      Select Case shn
        Case "A"
         oCol = "P"
         oList = "[" & oBook.Name & "]" & oSh.Name & "!" & _
                   Range("E" & oTop & ":" & oCol & z).Address
         decCol = Columns(oCol).Column - Columns("E").Column + 1
        Case "B"
         oCol = "O"
         oList = "[" & oBook.Name & "]" & oSh.Name & "!" & _
                   Range("H" & oTop & ":" & oCol & z).Address
         decCol = Columns(oCol).Column - Columns("H").Column + 1

        Case "C"
         oCol = "V"
          :
          :
        Case "D"
         oCol = "N"
          :
          :
      End Select

というようにしたいのですが、この構文では上記のエラーが表示されてしまいました。

どの位置に、どのように入れれば、シートごとのコード位置を判断できますでしょうか?

本当に申し訳ありませんが、よろしくお願いいたします。

【68237】Re:VLOOKUPを使ったデータの参照
回答  UO3  - 11/2/17(木) 10:29 -

引用なし
パスワード
   ▼ケメ子 さん:

おはようございます。

D列を固定化している部分は前月ファイルのほかに今月ファイルにもありますが、
それは、それでいいとして。

直接的なエラーの原因は、この時点では oSh に、まだシートオブジェクトがセットされて
いないということです。
(その下のブロックでoBookがある場合にのみoShにセットしています)

ですから、この構成のままやるとすれば、ますます煩雑になりますが、今回手を入れられた
Select Case のところではなく、私がアップしたコードでoList、decColにセットしている
ところを、あらためてSelect Case をおいて、シートごとに異なるoList、decColをセット
するというのが、一番手っ取り早い方法です。

でも、このシートごとに異なる、旧D列にあたるものをシートごとに変数にいれておき
oList、decList生成時に、"D"という固定値ではなく、この変数を与えるほうがよろしいかと。

前月度ブック用に oKey という変数を追加します。

Sub Sample作業()
  Dim myFso As Object
  Dim myFiles As Object
  Dim myFile As Object
  Dim shn As Variant  'シート名 A,B,C,D
  Dim z As Long
  Dim xlRowMax As Long 'エクセル最大行数

  '元データ関連
  Dim bPath As String  'サーバパス
  Dim bBook As Workbook 'ブック
  Dim bSh As Worksheet 'シート
  Dim bTop As Long   'データ開始行
  Dim bCol As String  'シートごとのデータ開始列
  Dim bRows As Long   'シートごとのデータ数
  '前月度関連
  Dim oPath As String  'サーバパス
  Dim oBook As Workbook 'ブック
  Dim oSh As Worksheet 'シート
  Dim oTop As Long   'データ開始行
  Dim oCol As String  'シートごとのデータ開始列
  Dim oRows As Long   'シートごとのデータ数
  Dim oName As String  'ブック名。元データも同じ。
  Dim oKey As String  'シートごとのkeyコード列
  Dim oList As String  'keyコード列から始まるVLOOKUPリスト領域アドレス
  Dim decCol As Long  '同上領域のデコード列番号(1〜)
  '今月度関連
  Dim nPath As String  'サーバパス
  Dim nBook As Workbook 'ブック
  Dim nSh As Worksheet 'シート
  Dim nTop As Long   'データ開始行
  Dim nName As String  'ブック名
  Dim nRank As Object  'ランクデコード領域
  Dim nRows As Long   'シートごとのデータ数
  Dim nBottom As Long  'シートごとのデータ最終行
 
  Application.ScreenUpdating = False
  Set myFso = CreateObject("Scripting.FileSystemObject")

  bPath = "c:\元データ"    '実際のサーバパス名に
  nPath = "c:\今月度"     '実際のサーバパス名に
  oPath = "c:\前月度提出用"  '実際のサーバパス名に
 
  bTop = 16  '元データ開始行
  oTop = 16  '前月度データ開始行
  nTop = 6  '今月度データ開始行
 
  xlRowMax = Rows.Count

  For Each myFile In myFso.GetFolder(nPath).Files
   nName = myFile.Name  '頭に【作業】つき
   oName = Mid(nName, 5) '頭の【作業】を除く
 
   If LCase(myFso.GetExtensionName(nName)) = "xls" And _
      Left(nName, 4) = "【作業】" And _
      myFso.FileExists(bPath & "\" & oName) Then
   
     Set nBook = Workbooks.Open(myFile.Path)
'------------------------------
'元ファイルから各シートへコピー
'------------------------------
     Set bBook = Workbooks.Open(bPath & "\" & oName)
   
     For Each shn In Array("A", "B", "C", "D")
      Select Case shn
        Case "A"
         bCol = "C"
        Case "B"
         bCol = "F"
        Case "C"
         bCol = "M"
        Case "D"
         bCol = "E"
      End Select
   
      Set bSh = bBook.Sheets(shn)
      Set nSh = nBook.Sheets(shn)
      z = bSh.Range(bCol & xlRowMax).End(xlUp).Row
      If z >= bTop Then '元データにデータが存在するときのみ、当シート処理
        bRows = z - bTop + 1
        nBottom = nTop + bRows - 1
        With nSh
         .Range("B6:E" & xlRowMax).ClearContents
         .Range("A6:A" & xlRowMax).ClearContents
         .Range("F7:I" & xlRowMax).ClearContents
         .Range("B6:D6").Resize(bRows).Value = _
              bSh.Range(bCol & bTop).Resize(bRows, 3).Value
         .Range("F" & nTop & ":I" & nBottom).Formula = _
              .Range("F" & nTop & ":I" & nTop).Formula '式をコピー
         .Range("A" & nTop).Value = 1
         .Range("A" & nTop).Resize(bRows).DataSeries '連番
        End With
      End If
     Next
  
     bBook.Close False
  
'----------------------------------------
'前月ファイルから各シートへランクデコード
'----------------------------------------
     Set oBook = Nothing
     If myFso.FileExists(oPath & "\" & oName) Then _
      Set oBook = Workbooks.Open(oPath & "\" & oName)
   
     For Each shn In Array("A", "B", "C", "D")
      Select Case shn
        Case "A"
         oCol = "P"
         oKey = "E"
        Case "B"
         oCol = "O"
         oKey = "H"
        Case "C"
         oCol = "V"
         oKey = "O"
        Case "D"
         oCol = "N"
         oKey = "G"
      End Select
  
      Set nSh = nBook.Sheets(shn)
      z = nSh.Range("D" & xlRowMax).End(xlUp).Row
      If z >= nTop Then 'データが存在するときのみ、当シート処理
        nRows = z - nTop + 1
        With nSh
         Set nRank = .Range("E" & nTop).Resize(nRows)
         If Not oBook Is Nothing Then
           Set oSh = oBook.Sheets(shn)
           z = oSh.Range(oCol & xlRowMax).End(xlUp).Row
           If z >= oTop Then
            oRows = z - oTop + 1
            oList = "[" & oBook.Name & "]" & oSh.Name & "!" & _
                   Range(oKey & oTop & ":" & oCol & z).Address
            decCol = Columns(oCol).Column - Columns(oKey).Column + 1
            nRank.Formula = _
              "=VLOOKUP(" & oKey & nTop & "," & oList & "," & decCol & ",FALSE)"
            nRank.Value = nRank.Value
           Else
            nRank.Formula = "#N/A" '前月ブックの当該シートにデータがない時
           End If
         Else
           nRank.Formula = "#N/A" '前月ブックがない時
         End If
        End With
      End If
     Next
'-------------------------------
'ブック処理完了 --> 次のブックへ
'-------------------------------
     If Not oBook Is Nothing Then oBook.Close False
     nBook.Close True
   End If
  Next
 
  Set nBook = Nothing
  Set oBook = Nothing
  Set bBook = Nothing
  Set nSh = Nothing
  Set oSh = Nothing
  Set bSh = Nothing
  Set nRank = Nothing
  Set myFso = Nothing
 
  Application.ScreenUpdating = True
 
  MsgBox "処理が終了しました。"

End Sub

【68240】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/17(木) 10:43 -

引用なし
パスワード
   ▼ケメ子 さん:

上でアップしたコード、構成というか方法としては、これでいいと思いますが
今、簡単なテストをしてみましたら、正しくデコードされていません。
いそいで書いたコードですから、どこかにバグがあるんでしょうね。

デバッグして、また連絡します。

【68243】Re:VLOOKUPを使ったデータの参照
回答  UO3  - 11/2/17(木) 11:02 -

引用なし
パスワード
   ▼ケメ子 さん:

デバッグ完了(だと思いますが・・・)
1ヶ所、今月ファイルの固定のD列も前月ファイル用の変数にしていたところがありました。

修正版、アップします。

Sub Sample作業()
  Dim myFso As Object
  Dim myFiles As Object
  Dim myFile As Object
  Dim shn As Variant  'シート名 A,B,C,D
  Dim z As Long
  Dim xlRowMax As Long 'エクセル最大行数

  '元データ関連
  Dim bPath As String  'サーバパス
  Dim bBook As Workbook 'ブック
  Dim bSh As Worksheet 'シート
  Dim bTop As Long   'データ開始行
  Dim bCol As String  'シートごとのデータ開始列
  Dim bRows As Long   'シートごとのデータ数
  '前月度関連
  Dim oPath As String  'サーバパス
  Dim oBook As Workbook 'ブック
  Dim oSh As Worksheet 'シート
  Dim oTop As Long   'データ開始行
  Dim oCol As String  'シートごとのデータ開始列
  Dim oRows As Long   'シートごとのデータ数
  Dim oName As String  'ブック名。元データも同じ。
  Dim oKey As String  'シートごとのkeyコード列
  Dim oList As String  'keyコード列から始まるVLOOKUPリスト領域アドレス
  Dim decCol As Long  '同上領域のデコード列番号(1〜)
  '今月度関連
  Dim nPath As String  'サーバパス
  Dim nBook As Workbook 'ブック
  Dim nSh As Worksheet 'シート
  Dim nTop As Long   'データ開始行
  Dim nName As String  'ブック名
  Dim nRank As Object  'ランクデコード領域
  Dim nRows As Long   'シートごとのデータ数
  Dim nBottom As Long  'シートごとのデータ最終行
 
  Application.ScreenUpdating = False
  Set myFso = CreateObject("Scripting.FileSystemObject")

  bPath = "c:\元データ"    '実際のサーバパス名に
  nPath = "c:\今月度"     '実際のサーバパス名に
  oPath = "c:\前月度提出用"  '実際のサーバパス名に
 
  bTop = 16  '元データ開始行
  oTop = 16  '前月度データ開始行
  nTop = 6  '今月度データ開始行
 
  xlRowMax = Rows.Count

  For Each myFile In myFso.GetFolder(nPath).Files
   nName = myFile.Name  '頭に【作業】つき
   oName = Mid(nName, 5) '頭の【作業】を除く
 
   If LCase(myFso.GetExtensionName(nName)) = "xls" And _
      Left(nName, 4) = "【作業】" And _
      myFso.FileExists(bPath & "\" & oName) Then
   
     Set nBook = Workbooks.Open(myFile.Path)
'------------------------------
'元ファイルから各シートへコピー
'------------------------------
     Set bBook = Workbooks.Open(bPath & "\" & oName)
   
     For Each shn In Array("A", "B", "C", "D")
      Select Case shn
        Case "A"
         bCol = "C"
        Case "B"
         bCol = "F"
        Case "C"
         bCol = "M"
        Case "D"
         bCol = "E"
      End Select
   
      Set bSh = bBook.Sheets(shn)
      Set nSh = nBook.Sheets(shn)
      z = bSh.Range(bCol & xlRowMax).End(xlUp).Row
      If z >= bTop Then '元データにデータが存在するときのみ、当シート処理
        bRows = z - bTop + 1
        nBottom = nTop + bRows - 1
        With nSh
         .Range("B6:E" & xlRowMax).ClearContents
         .Range("A6:A" & xlRowMax).ClearContents
         .Range("F7:I" & xlRowMax).ClearContents
         .Range("B6:D6").Resize(bRows).Value = _
              bSh.Range(bCol & bTop).Resize(bRows, 3).Value
         .Range("F" & nTop & ":I" & nBottom).Formula = _
              .Range("F" & nTop & ":I" & nTop).Formula '式をコピー
         .Range("A" & nTop).Value = 1
         .Range("A" & nTop).Resize(bRows).DataSeries '連番
        End With
      End If
     Next
  
     bBook.Close False
  
'----------------------------------------
'前月ファイルから各シートへランクデコード
'----------------------------------------
     Set oBook = Nothing
     If myFso.FileExists(oPath & "\" & oName) Then _
      Set oBook = Workbooks.Open(oPath & "\" & oName)
   
     For Each shn In Array("A", "B", "C", "D")
      Select Case shn
        Case "A"
         oCol = "P"
         oKey = "E"
        Case "B"
         oCol = "O"
         oKey = "H"
        Case "C"
         oCol = "V"
         oKey = "O"
        Case "D"
         oCol = "N"
         oKey = "G"
      End Select
  
      Set nSh = nBook.Sheets(shn)
      z = nSh.Range("D" & xlRowMax).End(xlUp).Row
      If z >= nTop Then 'データが存在するときのみ、当シート処理
        nRows = z - nTop + 1
        With nSh
         Set nRank = .Range("E" & nTop).Resize(nRows)
         If Not oBook Is Nothing Then
           Set oSh = oBook.Sheets(shn)
           z = oSh.Range(oCol & xlRowMax).End(xlUp).Row
           If z >= oTop Then
            oRows = z - oTop + 1
            oList = "[" & oBook.Name & "]" & oSh.Name & "!" & _
                   Range(oKey & oTop & ":" & oCol & z).Address
            decCol = Columns(oCol).Column - Columns(oKey).Column + 1
            nRank.Formula = _
              "=VLOOKUP(D" & nTop & "," & oList & "," & decCol & ",FALSE)"
            nRank.Value = nRank.Value
           Else
            nRank.Formula = "#N/A" '前月ブックの当該シートにデータがない時
           End If
         Else
           nRank.Formula = "#N/A" '前月ブックがない時
         End If
        End With
      End If
     Next
'-------------------------------
'ブック処理完了 --> 次のブックへ
'-------------------------------
     If Not oBook Is Nothing Then oBook.Close False
     nBook.Close True
   End If
  Next
 
  Set nBook = Nothing
  Set oBook = Nothing
  Set bBook = Nothing
  Set nSh = Nothing
  Set oSh = Nothing
  Set bSh = Nothing
  Set nRank = Nothing
  Set myFso = Nothing
 
  Application.ScreenUpdating = True
 
  MsgBox "処理が終了しました。"

End Sub

【68254】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/17(木) 22:39 -

引用なし
パスワード
   UO3さま

本当にありがとうございます。。。
エラーの原因もご説明いただき、恐れ入ります。

修正いただいたコードをさっそく試させていただいたのですが、以下の部分でエラーが出てしまいました。

>'----------------------------------------
>'前月ファイルから各シートへランクデコード
>'----------------------------------------



>            nRank.Formula = _
>              "=VLOOKUP(D" & nTop & "," & oList & "," & decCol & ",FALSE)"

こちらがハイライトされてしまいました…
何が原因なんでしょうか。

実は、UO3様が考案してくださっているコードのシート名や、データの開始行、貼り付け先の列など、会社からの要望で、コードの中に直接組み込むのではなく、マクロ用の作業ファイルを別に作り、そこに「開始列;E」列、というように、マクロを知らない人も列番号などを指定すれば、それに応じて処理できるようにしてあります。
たとえば、「D」という列を指定したい場合は、その「D」列という文字が入っているセル番地(例えばP13に入っているとすると ThisWorkbook.Sheets(1).Range("P13").Valueというように)
に置き換えております。

そのハイライトされているところまでは、きちんとファイルも開き、ClearContentsも行われているので、ファイル名の指定などは問題なさそうです。

何度も申し訳ございませんが、ご回答おまちしております。

【68255】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/17(木) 23:08 -

引用なし
パスワード
   ▼ケメ子 さん:
>実は、UO3様が考案してくださっているコードのシート名や、データの開始行、貼り付け先の列など、会社からの要望で、コードの中に直接組み込むのではなく、マクロ用の作業ファイルを別に作り、そこに「開始列;E」列、というように、マクロを知らない人も列番号などを指定すれば、それに応じて処理できるようにしてあります。

これは、きわめて〔正しい妥当な方式〕だと思います。
私のオフィスでスタッフが処理しているものも、そういったつくりにしています。
(じゃないと、しょっちゅうコードpを修正してあげなきゃいけなくなるので)

で、創造ですが、別のところに規定してある値を変数として記述している部分で
(よくあるケースですが)" でくくられた文字列との連結がうまくいっていないのではと
思います。

手直しされたコードを全てアップいただければ具体的にチェックできるのですが。

【68259】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/18(金) 21:14 -

引用なし
パスワード
   UO3さま

毎度本当にご迷惑おかけしております。

>別のところに規定してある値を変数として記述している部分で
>(よくあるケースですが)" でくくられた文字列との連結がうまくいっていないのではと思います。

ありがとうございます。
そうかな、とも思い、こちらの部分だけ、「D」とコードの中に入れてみましたが、やはりエラーが出てしまいました・・・


>手直しされたコードを全てアップいただければ具体的にチェックできるのですが。

そうですね。
それが、申し訳ないことに、会社で作成しているコードを持ち帰るのを忘れました。。。
またもや、月曜日に貼り付けさせていただきます。

ちなみに、UO3さまが考案くださったコードで、若干仕様を変えさせていただいております。

 1.元データ、前月提出用データ、今月作業用データの変数についている
  b、o、nを、a、b、cに変更(アナログ上司がa、b、cにしろ!というもの
  で・・・すみません。。。)

 2.すでに記述した通り、列番号・行番号などはワークシート上の値を参照

 3.そのため、”【作業】”がつくファイル名も、これから変わるかもしれないと
  のことで、文字数が変わっても対応できるように、MID関数ではなく、前回
  ご考案いただいた方法(myFileを【作業】なしのファイル名)に変更

この3点になります。
とくに1.は、置換機能で行ったですし、チェックした時も間違いがなかった(つもり)なんですが、ここがいけないのでしょうか・・・

とにかく、これだけでは原因が分かりませんので、月曜日(もしかしたら火曜日になるかもしれませんが)にご連絡いたします。

今後ともよろしくお願いいたします。

【68303】Re:VLOOKUPを使ったデータの参照
質問  ケメ子  - 11/2/22(火) 0:44 -

引用なし
パスワード
   UO3さま

遅くなりまして申し訳ございません、ケメ子です。
会社ではネット不可のため、メールも使用できず、印刷したものを自宅で入力いたしましたので、ご覧いただきたいと思います。

*********************************

Sub 作業ファイル作成()
  Dim myFso As Object
  Dim myFiles As Object
  Dim myFile As Object
  Dim shn As Variant
  Dim z As Long
  Dim xlRowMax As Long

  '元データ関連・・・・a
  Dim aPath As String
  Dim aBook As Workbook
  Dim aSh As Worksheet
  Dim aTop As Long
  Dim aCol As String
  Dim aRows As Long
  Dim aName As String

  '前月提出用データ関連・・・・b
  Dim bPath As String
  Dim bBook As Workbook
  Dim bSh As Worksheet
  Dim bTop As Long
  Dim bCol As String
  Dim bRows As Long
  Dim bKey As String
  Dim bList As String
  Dim decCol As Long

  '今月作業用データ関連・・・・c
  Dim cPath As String
  Dim cBook As Workbook
  Dim cSh As Worksheet
  Dim cTop As Long
  Dim cName As String
  Dim cRank As Object
  Dim cRows As Long
  Dim cBottom As Long

  Application.ScreenUpdating = False
  Set myFso = CreateObject("Scripting.FileSystemObject")

  aPath = ThisWorkbook.Sheets(1).Range("D4").Value  '元データ(a)の保存先セル
  bPath = ThisWorkbook.Sheets(1).Range("D5").Value  '前月提出用データ(b)の保存先セル
  cPath = ThisWorkbook.Sheets(1).Range("K4").Value  '今月作業用データ(c)の保存先セル

  shn2 = ThisWorkbook.Sheets(1).Range("D8").Value   'シートAのシート名入力セル
  shn3 = ThisWorkbook.Sheets(1).Range("D9").Value   'シートBのシート名入力セル
  shn4 = ThisWorkbook.Sheets(1).Range("D10").Value  'シートCのシート名入力セル
  shn5 = ThisWorkbook.Sheets(1).Range("D11").Value  'シートDのシート名入力セル

  aTop = ThisWorkbook.Sheets(1).Range("D12").Value  '元データ開始行
  bTop = ThisWorkbook.Sheets(1).Range("D12").Value  '前月データ開始行(元データと同じ=16行目)
  cTop = ThisWorkbook.Sheets(1).Range("K11").Value  '今月データ開始行(6行目)

  xlRowMax = Rows.Count

  For Each myFile In myFso.GetFolder(aPath).Files
    aName = myFile.Name
    cName = ThisWorkbook.Sheets(1).Range("K5").Value & myFile.Name '頭にセルK5の値(【作業】)付き
  
  If LCase(myFso.GetExtensionName(aName)) = "xls" And _
    myFso.FileExists(cPath & "\" & cName) Then
      Set cBook = Workbooks.Open(cPath & "\" & cName, UpdateLinks:=3) 'リンクの更新して開く
      
'------------------------------
'元ファイルから各シートへコピー
'------------------------------
      
  Set aBook = Workbooks.Open(aPath & "\" & aName, Password:=ThisWorkbook.Sheets(1).Range("D7").Value) 'セルD7のパスワードで開く

  For Each shn In Array(shn2, shn3, shn4, shn5)
    Select Case shn
      Case shn2
        aCol = ThisWorkbook.Sheets(1).Range("E13").Value
          '元データのシートAの「証券銘柄名」「証券銘柄コード」「Keyコード」範囲 開始列(C列)
             
      Case shn3
        aCol = ThisWorkbook.Sheets(1).Range("E14").Value
          '元データのシートBの「証券銘柄名」「証券銘柄コード」「Keyコード」範囲 開始列(F列)
            
      Case shn4
        aCol = ThisWorkbook.Sheets(1).Range("E15").Value
          '元データのシートCの「証券銘柄名」「証券銘柄コード」「Keyコード」範囲 開始列(M列)
            
      Case shn5
        aCol = ThisWorkbook.Sheets(1).Range("E16").Value
             '元データのシートDの「証券銘柄名」「証券銘柄コード」「Keyコード」範囲 開始列(E列)
     End Select
        
      Set aSh = aBook.Sheets(shn)
      Set cSh = cBook.Sheets(shn)
      z = aSh.Range(aCol & xlRowMax).End(xlUp).Row
      If z >= aTop Then
        aRows = z - aTop + 1
        cBottom = cTop + aRows - 1
        With cSh
          .Range(ThisWorkbook.Sheets(1).Range("R13").Value & xlRowMax).ClearContents
            '消去範囲1(B6:D)が記載されているセル番地
            
          .Range(ThisWorkbook.Sheets(1).Range("R14").Value & xlRowMax).ClearContents
            '消去範囲2(E6:E)が記載されているセル番地
            
          .Range(ThisWorkbook.Sheets(1).Range("R15").Value & xlRowMax).ClearContents
            '消去範囲3(A6:A)が記載されているセル番地
            
          .Range(ThisWorkbook.Sheets(1).Range("R16").Value & xlRowMax).ClearContents
            '消去範囲4(F7:I)が記載されているセル番地

          .Range(ThisWorkbook.Sheets(1).Range("R18").Value).Resize(aRows).Value = _
            aSh.Range(aCol & aTop).Resize(aRows, 3).Value
          .Range(ThisWorkbook.Sheets(1).Range("M18").Value & cTop & ":" & ThisWorkbook.Sheets(1).Range("O18").Value & cBottom).Formula = _
            .Range(ThisWorkbook.Sheets(1).Range("M18").Value & cTop & ":" & ThisWorkbook.Sheets(1).Range("O18").Value & cTop).Formula
            .Range(ThisWorkbook.Sheets(1).Range("K12").Value & cTop).Value = 1
            .Range (ThisWorkbook.Sheets(1).Range("K12").Value & cTop), Resize(aRows).DataSeries
        End With
      End If
    Next
    
    aBook.Close False
    
     
'----------------------------------------
'前月ファイルから各シートへランクデコード
'----------------------------------------

    
    Set bBook = Nothing
    If myFso.FileExists(bPath & "\" & aName) Then _
      Set bBook = Workbooks.Open(bPath & "\" & aName, Password:=ThisWorkbook.Sheets(1).Range("D7").Value)
      
    For Each shn In Array(shn2, shn3, shn4, shn5)
      Select Case shn
        Case shn2
          bCol = ThisWorkbook.Sheets(1).Range("E17").Value
          bKey = ThisWorkbook.Sheets(1).Range("G13").Value
        Case shn3
          bCol = ThisWorkbook.Sheets(1).Range("E18").Value
          bKey = ThisWorkbook.Sheets(1).Range("G14").Value
        Case shn4
          bCol = ThisWorkbook.Sheets(1).Range("E19").Value
          bKey = ThisWorkbook.Sheets(1).Range("G15").Value
        Case shn5
          bCol = ThisWorkbook.Sheets(1).Range("E20").Value
          bKey = ThisWorkbook.Sheets(1).Range("G16").Value
      End Select
      
      Set cSh = cBook.Sheets(shn)
      z = cSh.Range(ThisWorkbook.Sheets(1).Range("P13").Value & xlRowMax).End(xlUp).Row
      If z >= cTop Then
        cRows = z - cTop + 1
        With cSh
          Set cRank = .Range(ThisWorkbook.Sheets(1).Range("K17").Value & cTop).Resize(cRows)
          If Not bBook Is Nothing Then
            Set bSh = bBook.Sheets(shn)
            z = bSh.Range(bCol & xlRowMax).End(xlUp).Row
            If z >= bTop Then
              bRows = z - bTop + 1
              bList = "[" & bBook.Name & "]" & bSh.Name & "!" & _
                Range(bKey & bTop & ":" & bCol & z).Address
              decCol = Columns(bCol).Column - Columns(bKey).Column + 1
              cRank.Formula = _
                "=VLOOKUP(D" & cTop & "," & bList & "," & decCol & ",FALSE)"
              cRank.Value = cRank.Value
            Else
              cRank.Formula = "#N/A"
            End If
          Else
            cRank.Formula = "#N/A"
          End If
        End With
      End If
    Next
    
'    -------------------------------
'ブック処理完了 --> 次のブックへ
'-------------------------------

    
        If Not bBook Is Nothing Then
          bBook.Close False
          cBook.Close True
        End If
    Next
    
    Set cBook = Nothing
    Set bBook = Nothing
    Set aBook = Nothing
    Set cSh = Nothing
    Set bSh = Nothing
    Set aSh = Nothing
    Set cRank = Nothing
    Set myFso = Nothing
    
    Application.ScreenUpdating = True
    
    Msg.Box "処理が終了しました。"

End Sub

*****************************

こちらになりますが、コンパイルしてみたところ、会社では出なかったエラーが出てきました。

'------------------------------
'元ファイルから各シートへコピー
'------------------------------



>          .Range(ThisWorkbook.Sheets(1).Range("M18").Value & cTop & ":" & ThisWorkbook.Sheets(1).Range("O18").Value & cBottom).Formula = _
>            .Range(ThisWorkbook.Sheets(1).Range("M18").Value & cTop & ":" & ThisWorkbook.Sheets(1).Range("O18").Value & cTop).Formula
>            .Range(ThisWorkbook.Sheets(1).Range("K12").Value & cTop).Value = 1
>            .Range (ThisWorkbook.Sheets(1).Range("K12").Value & cTop), Resize(aRows).DataSeries

で、最後の「Resize」の部分で、「subまたはFunctionが定義されていない」とのコンパイルエラーがでてしまいました。

会社では、次の段階の「VLOOKUP」の式が黄色くなってしまったのに、どこが抜けているのでしょう。

とりあえず、コードは新規ブックの何も入力されていないものにモジュールシートだけ挿入して入力しているので、そのせいでしょうか?

ちなみに「VLOOKUP」の部分だけは、セル参照せずに、「D」列をコードの中に組み込んでみましたが、会社ではこれでもエラーが出てしまいました。

これだけではイメージがおそらく湧きにくいとは思いますので、ご不明な点がありましたら、なんなくお知らせください。

本当に申し訳ありません…

【68306】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/22(火) 9:28 -

引用なし
パスワード
   ▼ケメ子 さん:

おはようございます。

手打ちでのコード作成、ご苦労様です。

・コンパイルエラー

 ご自宅で手打ちされたときの間違いでしょうけど、,(カンマ)Resieになってますね。
 .(ピリオド)Resize でコンパイルエラーはなくなると思います。

・実行時エラー

cRank.Formula = _
   "=VLOOKUP(D" & cTop & "," & bList & "," & decCol & ",FALSE)"
              
ここですよね。おそらくは、Formulaに与える文字列、コンスタントと変数の組合せ自体は
間違いないと思いますが、使われている変数の値、これはセルから取り込んだものを元に
しているわけですが、これが適切ではなくエラーになっていると思われます。
(極端に言えば 変数にいれたセルが空白とか)

このような場合の鉄則は、まず、文字列の内容を調べてみるということでしょうね。
このコードの直前に
MsgBox "=VLOOKUP(D" & cTop & "," & bList & "," & decCol & ",FALSE)"
として、表示される式が、ケメ子さんのイメージどおりかどうかを確かめてください。
MsgBoxは表示されている間しか確認できませんので
Debug.Print "=VLOOKUP(D" & cTop & "," & bList & "," & decCol & ",FALSE)"
としてイミディエイトウインドウに書き込んでおいて、ゆっくり確認するという手もあります。

ところで、変数をセルに外だしする方式、前にも申し上げましたように適切な考えだと
思いますし、当方でも、そのやりかたで運用している部分が多いのですが、それなりの
メリット・デメリットがあり、コード面でもそれなりの対処をしておくことが望まれます。
長くなりますので、後ほど、別スレとしてアップしますので、まずは上記の対処・調査をお願いします。

【68307】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/22(火) 9:50 -

引用なし
パスワード
   ▼ケメ子 さん:

もう1つ

これは、手打ちのコードでしょうから、会社の正式コードは正しいのでしょうが、
手打ちコードの
'------------------------------
'元ファイルから各シートへコピー
'------------------------------
の上にある、大ぐくりの For Each およびその下の If と
それに対するEnd If や Next の関係がちょっとおかしくなっているようですね。

【68308】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/22(火) 10:27 -

引用なし
パスワード
   ▼ケメ子 さん:

まずは、上で申し上げたように、【現在のコードとシート登録情報】でデバッグ願います。

今、ざっとコードを読みました。
【大変なつくり】になっていますので、デバッグも骨が折れることと思います。
オリジナルコードの中のセル領域の規定を【全て徹底的に】外だししておられます。
セル領域規定としては、あるものとあるものの列記号は同じでなければいけない
ところも多いですよね。ところが、実際のシートへの登録として異なった列記号を
入力してしまう場合もあるわけです。ここまでくると、シートの登録が【プログラミング】
のような性格になりますからコードのデバッグだけではなく、シート上の値の【デバッグ】
も必要になります。
コードデバッグなら、前後も含めてコードがあるわけですから、デバッグしやすいのですが
シート上には、セル領域文字列が羅列されているだけですから、これでデバッグしろと
いわれても、めちゃくちゃしんどい話になりますねぇ。

シートには3つのシートの必要な部分のレイアウト規定のみをおくべきだと思います。

後ほどアップ予定のコードは、そのあたりも工夫してみます。

【68314】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/23(水) 0:19 -

引用なし
パスワード
   UO3 さま

いつもありがとうございます。

>まずは、上で申し上げたように、【現在のコードとシート登録情報】でデバッグ願います。

かしこまりました。
明日確認してみます。

エラーの件、おっしゃるように、「Resize」の前がカンマでしたので、ピリオドに直したところ、OKになりました。
また、「ブック処理完了 --> 次のブックへ」のところで、
「If Not bBook〜Then」のあとに、不要な改行を入れていたので、そこのエラーも解決いたしました。
ありがとうございました。

まずは、こちらでもUO3さまのコードを直に確認させていただいたり、VLOOKUPの確認をしてみます。

いつも申し訳ありません。
今後ともよろしくお願いいたします。

【68315】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/23(水) 13:32 -

引用なし
パスワード
   ▼ケメ子 さん:

こんにちは

現在のコードとシートでデバッグ大変だと思いますが、がんばってください。

それとは別に、

1.まず、このレスで、現在の構えで気になっているところをメモしてみます。
2.次のレスで、気になっている部分の解消策の1つとして、新しいコードの(あくまで参考)
  ご提案と、そのコードで使われている、ちょっとなじみがないかもしれない記述の説明を
  します。
3.で、最後のレスで、その新しいコードを参考としてアップします。

新しいコードによる運用が、ケメ子さんにとって、保守しやすいものか、かえって保守が大変になるか
これはケメコさんのご判断で。

ということで、まず。

・各データのレイアウト規定を外出しにするということは、いいことだと思いますが、
 現在のコードから把握した限りではWorkSheet(1)にセットされている各情報が、飛び飛びのセルに
 配置されています。もちろん、実際のシートには、コメント等があって、どこの情報が何なのか
 お分かりになる仕掛けでしょうが、私の経験から言えば、ある程度まとまって記述されているほうが
 メンテナンスが楽だと考えます。
・本来は、ここで登録されたコード等が、列記号として妥当か、行番号として妥当か 等々のチェックを
 いれないと、実行時の障害になる可能性があります。とはいうものの、それをコード内でチェックすると
 VBAのコンパイルと同じようなロジックが必要になってくるでしょうから、ここは、「正しく登録されている」
 という前提でいくのが妥当でしょうね。(気にはなりますが)
・ただ、たとえば B6:D といったような コードで使うイメージで登録するのではなく、あくまで
 B とか、コピー列数としての3 といった登録にすべきかと。
・それとは別の懸念として、処理時点で、登録された情報を参照しているところが少なくないですね。
 ブック.シート.セル領域.プロパティ
 この記述があるとVBAは、まずブックのコレクションを見に行き、そのなかから指定ブックの情報が
 格納されているポインタを取得して、指定ブック情報を見ます。で、その中にあるシートコレクション
 のポインタを取得して、シートコレクションを見に行きます。次に、そこにあるシート情報に格納されている
 セル領域コレクションのポインタを取得して・・・・・・
 もちろん、これらのチェイニングは、あっというまですが、それでもループの中で毎回、これをやると
 処理時間に悪影響を与えます。(エクセルのセルへのコンタクトは結構、処理負荷が大きい)
 値が都度変化するものであればやむをえませんが、今回の場合は最初から最後まで固定値です。
 ですから、これらも、処理の最初で変数に取り込み、実行時は変数を相手にするべきだと思います。
 
といったことを感じました。
で、私なりのコード案を書いてみました。次と、その次のレスでご説明します。

【68316】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/23(水) 13:36 -

引用なし
パスワード
   ▼ケメ子 さん:

こんにちは

↑で申し上げた懸念も含めて、すこしは解消する構成案です。

1.まず、現在のWorksheet(1)に替えて、あるいは、それとは別に"Layout"というシートを
  準備します。このシートのA列に情報名、B列に、その値を記載します。
  コードとしてはB列だけを使います。
  (ざっと、レイアウト規定に最低限必要な情報をピックアップしましたら29個ありました)
2.これら情報を、処理の最初にVBAに取り込みます。
  通常は変数を規定しておいて、セルから変数への入れ込みを29行書くことになりますが
  ご提案コードでは、これを1から始まる配列変数 v に入れ込みます。
  (つまり、B列の値が v(1)からv(29)に入ります。)
3.コード内で v(1) とか v(29)と記述すると、後で見た人が何の項目かわからなくなりますね。
  ですから たとえば POSaPath = 1 といったような宣言をしておいて v(POSaPath)というように
  使います。
4.で、これを規定するには
  Const POSaPath As Long = 1
  Const POSbPath As Long = 2
  といったように記述していくのが一般的ですが、今回は(もしかしたらケメ子さんがごらんになったことがない)
  Enum を使っています。

  Enum 任意の名前
   aaaa
   bbbb
   cccc
  End Enum
 
  こうしますと、aaaa=0,bbbb=1,cccc=2 と自動的に値を設定してくれます。
  今回は最初の項目を1にしますので、

  Enum Rayout   'データシートのレイアウト規定
   stLayout
   POSaPath      '元パス
   POSbPath      '前月パス
    ・・
   POScPre       '今月ファイルの接頭文字列
   edLayout
  End Enum
  
  といった記述にしています。
  stLayoutはあコードでは使っていません。0をふるためのダミーです。
  ちなみにPOSaPthから最後のPOScPreまで、先ほど申し上げたとおり29個になりますので
  POScPreは29ということになります。
  最後の、edLayoutもダミーです。項目数29を取得するために使います。

5.POSaPathからPOScPreの並びはLayoutシートに登録してあるものと同じにします。
  Layoutシートのほうは、追加で登録必要になったとき、随時登録可能です。
  ただし、それにあわせて、同じ場所に、追加された項目をあらわす変数を追加してください。
  Layoutシートの順番を入れ替えることも可能です。ただし、同様に、Enum記述の順番も
  それにあわせて変更します。
  (前項でPOSaPathに1を与えれば、ダミーのstLayoutは不要ですし、情報数はPOScPreの値
   ですからダミーのedLayoutも不要になりますが、記述順を変更した場合もコード修正しなくて
   いいようにしてあります)

ご参考までにこちらのレイアウトを以下にコピペします。
ちょっとたての位置が見づらいかもしれませんが、これをコピーして
RayoutシートのA列に「テキスト」で貼付け、以下の分解プロシジャを走らせれば
A列とB列に、それぞれセットされますので、もしよければお使いください。

Sub 分解()
  Dim c As Range
  Dim s As String
  Dim v As Variant
  Dim w As Variant
  For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
   s = Replace(c.Value, " ", " ")
   v = Split(s, " ")
   w = v
   w(UBound(w)) = ""
   Cells(c.Row, "A").Value = Join(w, "")
   Cells(c.Row, "B").Value = v(UBound(v))
  Next
End Sub


元パス    c:\元データ
前月パス    c:\前月度提出用
今月パス    c:\今月度
シートAのシート名    A
シートBのシート名    B
シートCのシート名    C
シートDのシート名    D
元 データ開始行    16
元 シートAのデータ開始列    C
元 シートBのデータ開始列    F
元 シートCのデータ開始列    M
元 シートDのデータ開始列    E
前月 データ開始行    16
前月 シートAのkeyデータ列    E
前月 シートBのkeyデータ列    H
前月 シートCのkeyデータ列    O
前月 シートDのkeyデータ列    G
前月 シートAのランク列    P
前月 シートBのランク列    O
前月 シートCのランク列    V
前月 シートDのランク列    N
今月 データ開始行    6
今月 データ開始列    B
今月 keyデータ列    D
今月 ランク列    E
今月 式の開始列    F
今月 式の列数    4
元->今月 コピー列数    3
今月ファイルの接頭文字列    【作業】

【68317】Re:VLOOKUPを使ったデータの参照
回答  UO3  - 11/2/23(水) 13:38 -

引用なし
パスワード
   ▼ケメ子 さん:

さてコード案です。
これが、ケメ子さんにとって役立つのか、かえって煩雑なのかは、心もとないのですが。
なお、【作業】を外出しにしたことから、ケメ子さんのほうで、

元データを抽出-->それに紐つく今月データを読み込む

という流れに変更されていましたが、外出しにしながらも、コードで対応可能でしたので

もともとの 今月データを抽出-->それに紐つく元データを読み込む

このように、元戻ししてあります。

Option Explicit

Enum Rayout   'データシートのレイアウト規定
   stLayout
   POSaPath      '元パス
   POSbPath      '前月パス
   POScPath      '今月パス
   POSshn2       'シートAのシート名
   POSshn3       'シートBのシート名
   POSshn4       'シートCのシート名
   POSshn5       'シートDのシート名
   POSaTop       '元 データ開始行
   POSaCol2      '元 シートAのデータ開始列
   POSaCol3      '元 シートBのデータ開始列
   POSaCol4      '元 シートCのデータ開始列
   POSaCol5      '元 シートDのデータ開始列
   POSbTop       '前月 データ開始行
   POSbkey2      '前月 シートAのkeyデータ列
   POSbkey3      '前月 シートBのkeyデータ列
   POSbkey4      '前月 シートCのkeyデータ列
   POSbkey5      '前月 シートDのkeyデータ列
   POSbrank2      '前月 シートAのランク列
   POSbrank3      '前月 シートBのランク列
   POSbrank4      '前月 シートCのランク列
   POSbrank5      '前月 シートDのランク列
   POScTop       '今月 データ開始行
   POScCol       '今月 データ開始列
   POScKey       '今月 keyデータ列
   POScRank      '今月 ランク列
   POScformula     '今月 式の開始列
   POScnosform     '今月 式の列数
   POScopycols     '元->今月 コピー列数
   POScPre       '今月ファイルの接頭文字列
   edLayout
  End Enum
 
Sub Sample作業2()
  Dim v As Variant   'レイアウト情報格納配列
  Dim myFso As Object
  Dim myFiles As Object
  Dim myFile As Object
  Dim shn As Variant  'シート名 A,B,C,D
  Dim z As Long
  Dim xlRowMax As Long 'エクセル最大行数

  '元データ関連
  Dim aBook As Workbook 'ブック
  Dim aSh As Worksheet 'シート
  Dim aCol As String  'シートごとのデータ開始列
  Dim aRows As Long   'シートごとのデータ数
  Dim aName As String  'ブック名。前月データも同じ。
  '前月度関連
  Dim bBook As Workbook 'ブック
  Dim bSh As Worksheet 'シート
  Dim bCol As String  'シートごとのデータ開始列
  Dim bRank As String  'シートごとのランク列
  Dim bRows As Long   'シートごとのデータ数
  Dim bName As String  'ブック名。元データも同じ。
  Dim bKey As String  'シートごとのkeyコード列
  Dim bList As String  'keyコード列から始まるVLOOKUPリスト領域アドレス
  Dim decCol As Long  '同上領域のデコード列番号(1〜)
  '今月度関連
  Dim cBook As Workbook 'ブック
  Dim cSh As Worksheet 'シート
  Dim cName As String  'ブック名
  Dim cDecR As Object  'ランクデコード領域
  Dim cRows As Long   'シートごとのデータ数
  Dim cBottom As Long  'シートごとのデータ最終行

  Application.ScreenUpdating = False
  Set myFso = CreateObject("Scripting.FileSystemObject")
 
  With ThisWorkbook.Worksheets("Layout")
   v = Application.Transpose(.Range("B1").Resize(edLayout - 1).Value)
   xlRowMax = .Rows.Count
  End With
 
  For Each myFile In myFso.GetFolder(v(POScPath)).Files
   cName = myFile.Name             '頭に【作業】つき
   aName = Replace(cName, v(POScPre), "", , 1) '頭の【作業】を除く
   bName = aName
 
   If LCase(myFso.GetExtensionName(cName)) = "xls" And _
      Left(cName, Len(v(POScPre))) = v(POScPre) And _
      myFso.FileExists(v(POSbPath) & "\" & bName) Then
 
     Set cBook = Workbooks.Open(myFile.Path)
'------------------------------
'元ファイルから各シートへコピー
'------------------------------
     Set aBook = Workbooks.Open(v(POSaPath) & "\" & bName)
 
     For Each shn In Array(v(POSshn2), v(POSshn3), v(POSshn4), v(POSshn5))
      Select Case shn
        Case v(POSshn2)
         aCol = v(POSaCol2)
        Case v(POSshn3)
         aCol = v(POSaCol3)
        Case v(POSshn4)
         aCol = v(POSaCol4)
        Case v(POSshn5)
         aCol = v(POSaCol5)
      End Select
 
      Set aSh = aBook.Sheets(shn)
      Set cSh = cBook.Sheets(shn)
      z = aSh.Range(aCol & xlRowMax).End(xlUp).Row
      If z >= v(POSaTop) Then '元データにデータが存在するときのみ、当シート処理
        aRows = z - v(POSaTop) + 1
        cBottom = v(POScTop) + aRows - 1
        With cSh
         .Range(v(POScCol) & v(POScTop)).Resize(xlRowMax - v(POScTop) + 1, v(POScopycols)).ClearContents
         .Range(v(POScformula) & v(POScTop) + 1).Resize(xlRowMax - v(POScTop)).ClearContents
         .Range(v(POScformula) & v(POScTop) + 1).Resize(xlRowMax - v(POScTop), v(POScnosform)).ClearContents
         .Range(v(POScCol) & v(POScTop)).Resize(aRows, v(POScopycols)).Value = _
              aSh.Range(aCol & v(POSaTop)).Resize(aRows, v(POScopycols)).Value
         .Range(v(POScformula) & v(POScTop)).Resize(cBottom - v(POScTop) + 1, v(POScnosform)).Formula = _
              .Range(v(POScformula) & v(POScTop)).Resize(, v(POScnosform)).Formula '式をコピー
         .Range(v(POScCol) & v(POScTop)).Value = 1
         .Range(v(POScCol) & v(POScTop)).Resize(aRows).DataSeries '連番
        End With
      End If
     Next
 
     aBook.Close False
 
'----------------------------------------
'前月ファイルから各シートへランクデコード
'----------------------------------------
     Set bBook = Nothing
     If myFso.FileExists(v(POSbPath) & "\" & bName) Then _
      Set bBook = Workbooks.Open(v(POSbPath) & "\" & bName)
 
     For Each shn In Array(v(POSshn2), v(POSshn3), v(POSshn4), v(POSshn5))
      Select Case shn
        Case v(POSshn2)
         bCol = v(POSbrank2)
         bKey = v(POSbkey2)
        Case v(POSshn3)
         bCol = v(POSbrank3)
         bKey = v(POSbkey3)
        Case v(POSshn4)
         bCol = v(POSbrank4)
         bKey = v(POSbkey4)
        Case v(POSshn5)
         bCol = v(POSbrank5)
         bKey = v(POSbkey5)
      End Select
 
      Set cSh = cBook.Sheets(shn)
      z = cSh.Range(v(POScCol) & xlRowMax).End(xlUp).Row
      If z >= v(POScTop) Then 'データが存在するときのみ、当シート処理
        cRows = z - v(POScTop) + 1
        With cSh
         Set cDecR = .Range(v(POScRank) & v(POScTop)).Resize(cRows)
         If Not bBook Is Nothing Then
           Set bSh = bBook.Sheets(shn)
           z = bSh.Range(bCol & xlRowMax).End(xlUp).Row
           If z >= v(POSbTop) Then
            bRows = z - v(POSbTop) + 1
            bList = "[" & bBook.Name & "]" & bSh.Name & "!" & _
                   Range(bKey & v(POSbTop) & ":" & bCol & z).Address
            decCol = Columns(bCol).Column - Columns(bKey).Column + 1
            cDecR.Formula = _
              "=VLOOKUP(" & v(POScKey) & v(POScTop) & "," & bList & "," & decCol & ",FALSE)"
            'cDecR.Value = cDecR.Value
           Else
            cDecR.Formula = "#N/A" '前月ブックの当該シートにデータがない時
           End If
         Else
           cDecR.Formula = "#N/A" '前月ブックがない時
         End If
        End With
      End If
     Next
'-------------------------------
'ブック処理完了 --> 次のブックへ
'-------------------------------
     If Not bBook Is Nothing Then bBook.Close False
     cBook.Close True
   End If
  Next

  Set cBook = Nothing
  Set bBook = Nothing
  Set aBook = Nothing
  Set cSh = Nothing
  Set bSh = Nothing
  Set aSh = Nothing
  Set cDecR = Nothing
  Set myFso = Nothing

  Application.ScreenUpdating = True

  MsgBox "処理が終了しました。"

End Sub

【68321】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/23(水) 22:04 -

引用なし
パスワード
   わぁ スペルミスしてますね。おはずかしい。
この名前はコードで使っていませんので、ABC でも、いろは でもいいのですが。

>Enum Rayout   'データシートのレイアウト規定
   ↓
Enum Layout   'データシートのレイアウト規定

にしておいたほうがいいですね。

【68322】Re:VLOOKUPを使ったデータの参照
質問  ケメ子  - 11/2/23(水) 22:04 -

引用なし
パスワード
   UO3さま

ケメ子です。
ご丁寧なご回答かつ詳しい解説をいただき、本当にありがとうございました。

> 私の経験から言えば、ある程度まとまって記述されているほうが
> メンテナンスが楽だと考えます。

そうですね。
これでは、あとでメンテナンスしたときに、分かる人がいないとお手上げになってしまいますね。

> ここで登録されたコード等が、列記号として妥当か、行番号として妥当か 等々のチェックをいれないと、実行時の障害になる可能性があります。

その通りですね。
例のVLOOKUPも、先にご教示いただいた方法で、正しく値が取得できているかを確認いたします。


> たとえば B6:D といったような コードで使うイメージで登録するのではなく、あくまでB とか、コピー列数としての3 といった登録にすべきかと。

確かに、これも一つのエラーの原因かな?とも思っておりました。
ちょっと、マクロ入りファイルのレイアウトを変更してみます。

> これらも、処理の最初で変数に取り込み、実行時は変数を相手にするべきだと思います。

ありがとうございます。
たしかに、ThisWorkbook〜から始まるセル位置をそのままですと、分かりにくいだけでなく、間違いも起きやすいし、実行時の処理速度などにもかかわりますね。

以上のことを踏まえながら、ご考案いただいたコードを、もう一度確認させていただきます。


悲しいことに、機密情報扱う場所におり、ネットワーク一切不可の環境ゆえ、UO3様のコードを自宅で印刷し、会社で手打ちしなければなりません;;

今度はカンマとピリオドなどに気を付けます。

★ 質問なのですが、ご考案いただいたコードの変数の宣言のところで、外出ししているセル番地は、
ThisWorkbook〜 Range("G5").Value のような形式でよろしいのでしょうか?

これでもう一度ご連絡させていただきます。

本当にありがとうございます。
ですが、あともう少しご面倒おかけします。
よろしくお願いいたします。

【68331】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/24(木) 11:46 -

引用なし
パスワード
   ▼ケメ子 さん:

こんにちは

>ネットワーク一切不可の環境ゆえ、UO3様のコードを自宅で印刷し、
>会社で手打ちしなければなりません;;

わぁ、大変ですね。ご苦労、お察し申し上げます。
まずは、現行のデバッグをして、新しくご提案したものは、いずれゆっくり
検討されればよろしいですよ。

>コードの変数の宣言のところで、外出ししているセル番地は、
>ThisWorkbook〜 Range("G5").Value のような形式でよろしいのでしょうか?

今回提案した外だし情報は"Layout"シートのB1〜B29にはいっていますので
外だし項目1 = ThisWorkbook.Sheets("Layout").Range("B1").Value
外だし項目1 = ThisWorkbook.Sheets("Layout").Range("B2").Value
等でいいわけですが、私のコードは、それを、一括して配列 v に落とし込んでいます。

With ThisWorkbook.Worksheets("Layout")
   v = Application.Transpose(.Range("B1").Resize(edLayout - 1).Value)
   xlRowMax = .Rows.Count
End With

この結果、v(1)、v(2) ・・・・ に値が入ります。
でも コードの中で v(1) なんて参照しても何を参照しているのか、可読性の面で問題が
ありますので POSaPath という変数の値を 1 にしてあって v(POSaPath) が元データの
サーバパス、v(POSbPath) が前月データのサーバパス といったように使っています。

【68333】Re:VLOOKUPを使ったデータの参照
発言  UO3  - 11/2/24(木) 11:47 -

引用なし
パスワード
   ▼ケメ子 さん:

ごめんなさい。

外だし項目1 = ThisWorkbook.Sheets("Layout").Range("B2").Value



外だし項目2 = ThisWorkbook.Sheets("Layout").Range("B2").Value

の記入ミスです。

【68346】Re:VLOOKUPを使ったデータの参照
発言  ケメ子  - 11/2/24(木) 22:46 -

引用なし
パスワード
   UO3さま

ご回答いただきありがとうございました。
すみません、月末の別処理に追われ、今日は確認できませんでしたので、また近い日に確認させていただきます。

とりいそぎ御礼をさせていただきますが、またご報告いたします。
よろしくお願いいたします。

ケメ子

【68421】Re:VLOOKUPを使ったデータの参照2
質問  ケメ子  - 11/3/3(木) 20:15 -

引用なし
パスワード
   UO3さま

ご報告が遅くなりまして、大変申し訳ございませんでした。
確認したところ、エラーの原因がわかりました。

VLOOKUPの式に入ってる「bList」の変数の内容

bList = "[" & bBook.Name & "]" & bSh.Name & "!" & _
                Range(bKey & bTop & ":" & bCol & z).Address

の"["の前後に「'」が必要でした。
こちらを入れましたら、OKでした!!

ところが、貼り付け終わった後、作業ファイルの格付けの中に「0」が表示されている箇所がありました。

こちらは、参照元の前月ファイルとコードが一致しているが、格付けがブランクになっていたものを参照したためと思われます。

結構こういった箇所があるため、作業ファイルの格付けが「0」になってしまっている箇所は、ブランク表示したいのですが、Excelの式の感覚で、
=IF(VLOOKUP(・・・・)=0,",VLOOKUP(・・・・))という式を入れてみるとエラーが起きてしまいます。

ネストがだめなのか、IFがだめなのかわかりませんが、どうしたら「0」の箇所を空白にできるのかご教示ください。

おかげさまで、もう少しでゴールです。
本当にありがとうございます。

どうぞよろしくお願いいたします。

【68425】Re:VLOOKUPを使ったデータの参照2
回答  UO3  - 11/3/4(金) 12:32 -

引用なし
パスワード
   ▼ケメ子 さん:

こんにちは

エラーをクリアし、ゴールの薄明かりが見えてきたようで同慶の至りです。

>の"["の前後に「'」が必要でした。
>こちらを入れましたら、OKでした!!

こちらでは、 ' ではさまずともOKなのですが、ともあれ先に進んだわけで
よかったですね。

>格付けの中に「0」が表示されている箇所がありました。
>参照元の前月ファイルとコードが一致しているが、格付けがブランクになっていたものを参照

そうなりますね。
式としては、ぎょっとしますが、

>=IF(VLOOKUP(・・・・)=0,",VLOOKUP(・・・・))

このTrueの場合のところを """" ( " を 4つ)にしてお試しください。

【68426】できました!! ですが・・・
質問  ケメ子  - 11/3/4(金) 20:31 -

引用なし
パスワード
   UO3さま

いつもありがとうございます。

>このTrueの場合のところを """" ( " を 4つ)にしてお試しください。

うわ、こんなことだったんですね!!!!
いとも簡単にスルーしました。
本当にありがとうございました<m(__)m

ほんとはこれで完成のはずだったんですが、ファイル名が・・・

元→×××××××××(数字9ケタ) ファンド名
前月→××××××××× ファンド名
作業用→【作業】××××××××× ファンド名

基本はこうなんですが、9ケタの数字の後のファンド名の前にスペースがあったりなかったりしてました!!

しかも同じ番号のものが、同じようにスペースがあったりなかったりしていればいいのですが、同じ番号でも、そのあとにスペースの有無があったり、また、ファンド名も「クレジットミックス」とカナで入っているものもあれば、「C-MX」と英語で略しているものもあります。

ただし、番号は、3種類とも同じです。
その場限りなら、ファイル名を手修正するのもアリなんですが、いろいろな会社から入力されているので、なかなかファイル名の統一がうまくいきません。

そこで、元、前月、作業とも「9ケタの番号が合っているファイル同志をやりとりする」というふうに変えたいと思います。

自分なりに、LEFTやMIDで見よう見まねでやってみたんですが、どうやっても「番号だけが一致しているファイル」を操作することができません・・・

本当に申し訳ないのですが、ご教示お願いいたします(泣)
すみません・・・

どの位置に、どのように入れたらよろしいのでしょうか。。。

【68429】Re:できました!! ですが・・・
発言  UO3  - 11/3/4(金) 21:51 -

引用なし
パスワード
   ▼ケメ子 さん:

現在のケメ子さんのコードが手元にありませんので、コードの完成品として
お届けするのは、ちょっと骨が折れるので、とりあえず、ヒントです。
ただし、以下のヒントを部品として現在のコードに組み込むとしても
現在のコードは1対1でファイルを紐つけていますよね。今回のやりかたでは
ワイルドカードでの抽出と比較になるので、単純なコード変更では無理だと
思います。どうするのが、もっとも対応しやすいかを考えて見ますので少し
時間ください。いずれにしてもヒント部品を。

Sub Test()
  Dim f1 As Variant
  Dim f2 As Variant
  Dim preStr As String
  
  preStr = "【作業】"
  
  f1 = "12345 ABC"
  f2 = "【作業】12345エービーシー"
  
  If Val(f1) = Val(Replace(f2, preStr, "")) Then
    MsgBox "同じ数字です" & vbLf & Val(f1)
  Else
    MsgBox "数字が異なります" & vbLf & Val(f1) & vbLf & Val(Replace(f2, preStr, ""))
  End If
  
  f1 = "123456 ABC"
  f2 = "【作業】12345エービーシー"
  
  If Val(f1) = Val(Replace(f2, preStr, "")) Then
    MsgBox "同じ数字です" & vbLf & Val(f1)
  Else
    MsgBox "数字が異なります" & vbLf & Val(f1) & vbLf & Val(Replace(f2, preStr, ""))
  End If
  
End Sub

【68431】Re:できました!! ですが・・・
回答  UO3  - 11/3/5(土) 16:58 -

引用なし
パスワード
   ▼ケメ子 さん:

こんにちは

もう少しまともなコードで記述します。
11/2/22(火) 0:44 にアップされたコードを踏まえています。
従来はaName=bNameでしたが、今回は異なる可能性もあるので、別途bNameを規定しましょう。
したがってbBookのOpenはbNmaeにて行うことにご留意ください。
(テストしてませんので不具合あればいってください)

追加

  Dim bName As String
  Dim myPre As String

コードの最初のほうで  

  myPre = ThisWorkbook.Sheets(1).Range("K5").Value

以下のように修正

  For Each myFile In myFso.GetFolder(aPath).Files
    aName = myFile.Name
    If LCase(myFso.GetExtensionName(aName)) = "xls" Then
'aPathのaBook(aName) 12345ABC から cPathのcBook(cName) 【作業】12345 エービーシー を紐つける
      cName = IsExists(cPath, aName, myPre)
      If cName <> "" Then
        Set cBook = Workbooks.Open(cPath & "\" & cName, UpdateLinks:=3) 'リンクの更新して開く
   
'------------------------------
'元ファイルから各シートへコピー
'------------------------------
   
         Set aBook = Workbooks.Open(aPath & "\" & aName, Password:=ThisWorkbook.Sheets(1).Range("D7").Value) 'セルD7のパスワードで開く
  
        '処理 省略
    
         aBook.Close False
  
  
'----------------------------------------
'前月ファイルから各シートへランクデコード
'----------------------------------------

  
       Set bBook = Nothing
'aNameから bPathのbBook(bName) 12345 ABC を紐つける
       bName = IsExists(bPath, aName, "")
       If bName <> "" Then _
         Set bBook = Workbooks.Open(bPath & "\" & bName, Password:=ThisWorkbook.Sheets(1).Range("D7").Value)
    
       '処理 省略
  
'-------------------------------
'ブック処理完了 --> 次のブックへ
'-------------------------------

  
        If Not bBook Is Nothing Then
         bBook.Close False
         cBook.Close True
        End If
        
      End If
      
    End If
    
  Next

さらに下記プロシジャを追加。

Private Function IsExists(myPath As String, myName As String, myPre As String) As String
  Dim fName As String
  Dim f1 As Long
  Dim wk As String
  f1 = Val(myName)
  
  fName = Dir(myPath & "\" & myPre & f1 & "*.xls")
  Do While fName <> ""
    wk = Replace(fName, myPre, "", , 1) '頭の【作業】を除く
    If f1 = Val(wk) Then
      IsExists = fName
      Exit Do
    End If
    fName = Dir()
  Loop

End Function

【68432】Re:できました!! ですが・・・
発言  ケメ子  - 11/3/5(土) 18:53 -

引用なし
パスワード
   UO3 さま

追加でご考案いただき、本当に恐れ入ります。

さっそく月曜日に確認させていただき、またご連絡いたします。
それにしても、ただただ尊敬するのみです・・・。

とりいそぎ御礼まで・・・

【68441】プロシージャの追加場所
質問  ケメ子  - 11/3/7(月) 21:21 -

引用なし
パスワード
   UO3 さま

いつもお世話になっております。
早速確認させていただいたのですが
>さらに下記プロシジャを追加。
>
>Private Function IsExists(myPath As String, myName As String, myPre As String) As String
>  Dim fName As String
>  Dim f1 As Long
>  Dim wk As String
>  f1 = Val(myName)
>  
>  fName = Dir(myPath & "\" & myPre & f1 & "*.xls")
>  Do While fName <> ""
>    wk = Replace(fName, myPre, "", , 1) '頭の【作業】を除く
>    If f1 = Val(wk) Then
>      IsExists = fName
>      Exit Do
>    End If
>    fName = Dir()
>  Loop
>
>End Function

は、どの位置に追加したらよろしいのでしょうか?
これは、最後のSub Endの次に追加すればよろしいのでしょうか?

追加した位置が悪いらしく、Sub Endが定義されていません、なるエラーが出てしまいました。。。

【68442】Re:プロシージャの追加場所
回答  UO3  - 11/3/7(月) 21:59 -

引用なし
パスワード
   ▼ケメ子 さん:
>は、どの位置に追加したらよろしいのでしょうか?
>これは、最後のSub Endの次に追加すればよろしいのでしょうか?
>
>追加した位置が悪いらしく、Sub Endが定義されていません、なるエラーが出てしまいました。。。

Sub 作業ファイル作成()
   ・
   ・
   ・
End Sub

Functionプロシジャは、ここにおいてください。

【68479】\(^o^)/
お礼  ケメ子  - 11/3/9(水) 20:58 -

引用なし
パスワード
   UO3 さま

御礼が遅くなりまして失礼いたしました。

長きにわたって大変お世話になりましたが、ついに成功いたしました!!!!
もう、UO3さまに何と感謝を申し上げてよいかわかりません・・・

本当に長々とありがとうございました。
UO3は素晴らしいです!!!!!

今回ご教示いただいたことを踏まえ、自分でももう少し工夫ができるように努めたいと思います。
とはいえ、やはりまだまだお世話になることがあるかと思いますので、どうか今後ともよろしくお願いいたします。

2365 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free