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

• #42439 Delila_1 veterán Nagyzoli27 #42437

  Új Válasz 2019-12-10 15:26:15 #42439

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Nagyzoli27 #42437 üzenetére

  Lehet, hogy csak egyszer lesz szükséged a makró eredményére. Itt van.

• #42438 Delila_1 veterán Nagyzoli27 #42437

  Új Válasz 2019-12-10 15:00:06 #42438

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  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