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

• #37287 Delila_1 veterán Vééé #37285

  Új Válasz 2018-02-08 07:47:19 #37287

  Ú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 Vééé #37285 üzenetére

  Írtam hozzá egy makrót. Nem mondom, hogy villámgyors lesz 40 k adatnál, de gyorsabb, mint "gyalogosan".

  Az adatok az A:D oszlopokban vannak, és címsor van az első sorban.
  Az A oszlopot átmásolja a G-be, ott megszünteti a duplikációkat. Az összevont B-D adatokat a H oszlopba írja, pontosvesszővel elválasztva.
  A körlevélben a G lesz a cím, a H a szöveg.

  Sub Korlevelhez()
Dim sor As Long, tartomanyA As Range, tartomanyG As Range
Dim CVA As Range, CVG As Range, oszlop As Integer, szoveg As String

Columns("A:A").Copy Range("G1") 'másolás a G oszlopba

'Duplikációk megszüntetése
ActiveSheet.Range("$G:$G").RemoveDuplicates Columns:=1, Header:=xlNo

Set tartomanyA = Range("A2" & ":A" & Range("A2").End(xlDown).Row)
Set tartomanyG = Range("G2" & ":G" & Range("G2").End(xlDown).Row)

'Összevonás a H oszlopba
For Each CVG In tartomanyG
For Each CVA In tartomanyA
If CVA = CVG Then
szoveg = ""
For oszlop = 2 To 4
szoveg = szoveg & Cells(CVA.Row, oszlop) & ";"
Next
Cells(CVG.Row, "H") = Cells(CVG.Row, "H") & szoveg
End If
Next
Next
End Sub

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