활성 상태 인 vba 참조 통합 문서 및 파일 이름의 마지막 7 자에 x가 포함되어 있습니까?

Question

사용자가 너무 같은 C5 셀에 숫자 입력하면 나는 두 개의 통합 문서 내 마스터 통합 문서의 워크 시트 변경 이벤트에

Master Workbook 
Slave workbook 

이 : 그럼

마스터 통합 문서

C5 = 1234 

를 내가 이 번호에 대한 제 노예 통합 문서의 열 E를 내려다보고 싶습니다. 찾으면

슬레이브 통합

Column E Column F 
1222  Beans 
1234  Cheese 

, 나 슬레이브 통합 문서 F 열에서 해당 값을 잡아 내 마스터 세포에 통합 C6 이것을 넣을.

마스터 통합 문서

C5 = 1234 
C6: Cheese 

다른 문제는 내 노예 통합 문서 난 절대 참조를 참조 할 수 없습니다 의미 수시로 이름을 변경합니다. 통합 문서 파일 이름의 마지막 7 개 문자가 '볼륨'

아무리 경우 슬레이브 통합 문서

열려있는 경우

1. 대신 나는 두 가지 조건에 따라 슬레이브 통합 문서를 참조 할 어떤 슬레이브 통합 문서로 이름이 변경되고, 마지막 문자 '볼륨'과 같이 파일 이름에 남아 :

   file1 16.01.17 volumes.xls 
   or 
   file1 19.01.17 volumes.xls 
   

   편집 여기 은 내 코드입니다 : 0

   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