Hirdetés

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

  • Delila_1

    veterán

    válasz Nagyzoli27 #42437 üzenetére

    Módosítottam a makrón. A sok sorod miatt a változókat Long típusúnak kellett megadni, és azt nem írtad, hogy az első táblázatban vannak tételek, amikhez nem tartozik kapcsolódó ID.

    Működik a makró, de nagyon sokáig fut. Érdemes megnézned Mutt ajánlatát.
    Azért bemásolom ide a makrót. Kibővítettem azzal, hogy az A oszlop tartalmát átmásolja a D oszlopba, majd eltávolítja az ismétlődéseket. A makrót tartalmazó fájlt makróbarátként kell elmenteni.

    Sub Kapcsolodo()
    Dim sor1 As Long, sor2 As Long, usor1 As Long, usor2 As Long

    Columns("A:A").Copy Range("D1")
    Columns("D:D").RemoveDuplicates Columns:=1, Header:=xlYes
    Range("B1").Copy Range("E1")

    usor1 = Range("A1").End(xlDown).Row
    usor2 = Range("D1").End(xlDown).Row

    For sor2 = 2 To usor2
    For sor1 = 2 To usor1
    If Cells(sor1, 2) <> "" Then
    If Cells(sor2, 4) = Cells(sor1, 1) Then
    If Cells(sor2, 5) = "" Then
    Cells(sor2, 5) = Cells(sor1, 2)
    Else
    Cells(sor2, 5) = Cells(sor2, 5) & "|" & Cells(sor1, 2)
    End If
    End If
    End If
    Next
    Next
    MsgBox "Kész van", vbInformation, "Értesítés"
    End Sub

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