Excel VBA質問箱 IV

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

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


13929 / 76732 ←次へ | 前へ→

【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」列をコードの中に組み込んでみましたが、会社ではこれでもエラーが出てしまいました。

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

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

0 hits

【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 お礼

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