Keresés

Új hozzászólás Aktív témák

  • zsolti_20

    senior tag

    válasz Fferi50 #43119 üzenetére

    Köszönöm a segítséget, megpróbáltam de így is hiba üzentet kapok ezzel a kóddal:

    Sub UpdateW2()
    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 = Workbooks("1.xlsx").Sheets("Sheet1")
    Set FD = Application.FileDialog(3)
        With FD
            .AllowMultiSelect = False  'letiltja a többszörös kijelölést
            .Show  'Indítja a dialógboxot
            If .SelectedItems.Count = 0 Then
                MsgBox "Nem választottál fájlt, befejezzük.", vbInformation
            Else
                Fajnev = .SelectedItems(1)
                Set w2 = Workbooks.Open(fajlnev).Sheets("Sheet1")
                w1.Activate  'ha kell, az első füzet aktívvá tétele
                'műveletek
                'megnyitott füzet bezárása
            End If
        End With
    i = w1.Cells.SpecialCells(xlCellTypeLastCell).Row
    For Each oCell In w1.Range("A1:A" & i)
    If Not Dic.exists(oCell.Value) Then
    Dic.Add oCell.Value, oCell.Offset(, 3).Value
    End If
    Next
    i = w2.Cells.SpecialCells(xlCellTypeLastCell).Row
    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

Új hozzászólás Aktív témák