アクティブな場合はvbaリファレンスブック、ファイル名の最後の7文字にはxが含まれていますか？

Question

ユーザーがそうのように、セルC5に数値を入力した場合、私は、私のマスターブックのワークシートの変更イベントに2つのワークブック

Master Workbook 
Slave workbook 

を持っている：

マスターワークブック

C5 = 1234 

私は、私の奴隷のワークブックでこの数字の列Eを見たいと思っています。

スレーブワークブック

Column E Column F 
1222  Beans 
1234  Cheese 

見つかった場合、私は、スレーブ・ワークブックの列Fから対応する値を取得し、私のマスターワークブック上のセルC6にこれを載せていきたいと思います。

マスターワークブック

C5 = 1234 
C6: Cheese 

他の問題は私の奴隷ワークブックでは、私は絶対的な基準でそれを参照することはできませんつまり、時間から時間に名前を変更します。ブックファイル名の最後の7つの文字は「ボリューム」

どんなにしている場合、スレーブワークブックが

開いている場合は

1. ：代わりに、私は2つの条件に基づいて、スレーブブックを参照したいです何スレーブワークブックがそうのようなファイル名に残る最後の文字のボリュームの、名前に変更されます。ここでは

   file1 16.01.17 volumes.xls 
   or 
   file1 19.01.17 volumes.xls 
   

   EDIT は私のコードです：

   Private Sub Worksheet_SelectionChange(ByVal Target as Range) 
       Dim Dic As Object, key As Variant, oCell As Range, i& 
       Dim w1 As Worksheet, w2 As Worksheet 
   
       Set Dic = CreateObject("Scripting.Dictionary") 
       Set w1 = ThisWorkbook.Sheets(1) 
       Set w2 = Workbooks("workbookB.xlsm").Sheets("Sheet1") 
   
       i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row 
   
       For Each oCell In w1.Range("C5") 
        If Not Dic.exists(oCell.Value) Then 
         Dic.Add oCell.Value, oCell.Offset(1, 0).Value 
        End If 
       Next 
   
       i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row 
   
       For Each oCell In w2.Range("E4:E" & i) 
        For Each key In Dic 
         If oCell.Value = key Then 
          oCell.Offset(, 1).Value = Dic(key) 
         End If 
        Next 
       Next 
   End Sub 
   

   私は私のコードが正しいかどうか確認してくださいVBAする真新しいないですけど、誰かが、それは私が必要なものを行うために取得する方法私を見ることができますしてください？

   おかげ

Answer 1

下の編集したコードを試してみてください。

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 

    Dim Dic As Object, key As Variant, oCell As Range, i As Long 
    Dim w1 As Worksheet, w2 As Worksheet 

    Set Dic = CreateObject("Scripting.Dictionary") 
    Set w1 = ThisWorkbook.Sheets(1) 

    'With w1 
    ' i = .Cells(.Rows.Count, "D").End(xlUp).Row 
    'End With 

    For Each oCell In w1.Range("C5") 
     If Not Dic.exists(oCell.Value) Then 
      Dic.Add oCell.Value, oCell.Offset(, -3).Value 
     End If 
    Next 

    Dim wbInd As Integer 
    Dim wb2 As Workbook 

    For wbInd = 1 To Workbooks.Count ' <-- loop through all open workbooks 
     If Workbooks(wbInd).Name Like "*volumes.xlsx" Then '<-- check if workbook name contains "volumes" 
      Set wb2 = Workbooks(wbInd) 
      Exit For 
     End If 
    Next wbInd 

    Set w2 = wb2.Sheets("Sheet1") 

    With w2 
     i = .Cells(.Rows.Count, "A").End(xlUp).Row 
    End With 

    For Each oCell In w2.Range("A2:A" & i) 
     For Each key In Dic 
      If oCell.Value = key Then 
       oCell.Offset(, 2).Value = Dic(key) 
      End If 
     Next 
    Next 

End Sub 

---

編集1：Worksheet_Changeイベントにコードを移動し、セル "C5" の値がある場合にのみ、コードを実行します変更されました。

Private Sub Worksheet_Change(ByVal Target As Range) 

Dim Dic As Object, key As Variant, oCell As Range, i As Long 
Dim w1 As Worksheet, w2 As Worksheet 

If Not Intersect(Target, Range("C5")) Is Nothing Then ' <-- run this code only if a value in cell C5 has change 

    Application.EnableEvents = False 
    Set Dic = CreateObject("Scripting.Dictionary") 

    If Not Dic.exists(Target.Value) Then 
     Dic.Add Target.Value, Target.Offset(1, 0).Value 
    End If 

    Dim wbInd As Integer 
    Dim wb2 As Workbook 

    For wbInd = 1 To Workbooks.Count ' <-- loop through all open workbooks 
     If Workbooks(wbInd).Name Like "*volumes.xlsx" Then '<-- check if workbook name contains "volumes" 
      Set wb2 = Workbooks(wbInd) 
      Exit For 
     End If 
    Next wbInd 

    Set w2 = wb2.Sheets("Sheet1") 

    With w2 
     i = .Cells(.Rows.Count, "E").End(xlUp).Row 
    End With 

    For Each oCell In w2.Range("E2:E" & i) 
     For Each key In Dic 
      If oCell.Value = key Then 
       Target.Offset(1, 0).Value = oCell.Offset(0, 1) '<-- put the the value in column F (offset 1 column) to cell C6 (one row offset) 
      End If 
     Next 
    Next 
End If 

Application.EnableEvents = True 

End Sub