Flet med Word

Nej, der findes ingen konsolideringsfunktion, desværre. Brevfletning laver netop et brev pr. record, og det er sådan den er designet.Du er nok nødt til at gøre et eventuelt forarbejde i Excel, men det er også lidt af en udfordring. Du er simpelthen nødt til at samle alle navne, der vedrører samme firma sammen til en record.

Hvis du har tre kolonner i Excel

Firmanavn  Nacvn og E-mail, og det kun er de tre informationer, der skal "vendes", så de kan bruges til brevfletning, har jeg nok en makro, der kan gøre det, hvis du er interesseret.

Meget interesseret. Send venligst til laje3@mail.dk.
Jeg har godt nok mange kolonner (Oracle udtræk), men det finder jeg bare selv ud af, hvis du har makroen.

Skriver du to linier om hvad jeg skal gøre og hvad du mener med "vende"?

Tak, Laje

Makroen kan du få her - vi skal jo svare via eksperten :-). Den kommer nedenfor. Du kan bare kopiere den til et modul i Excel. Men først lidt vejledning.

Makroen forudsætter at Firmanavn står i A, Navn i B og E-mail i C.

Det vil nok være en god idé at kopiere alt over i et nyt ark, så du ikke "laver ulykker her", fx

A        B        C
Firma A  Olsen    o@A.dk
Firma B  Hansen  h@B.dk
Firma C  Svendsen s@c.dk
Firma A  Bendtsen b@a,dk
Firma B  Jensen  j@b.sk
Firma A  Madsen  m@a.dk

Når du afspiller makroen ændres til:
A        B        C      D        E      F      G 
Firma A  Olsen    o@A.dk  Bendtsen b@a.dk  Madsen m@a.dk
Firma B  Hansen  h@B.dk  Jensen  j@b.sk
Firma C  Svendsen s@c.dk
Firma A  Bendtsen b@a,dk
Firma B  Jensen  j@b.sk
Firma A  Madsen  m@a.dk

Nu kan du sortere Regnearket efter kolonne A. Slet alle dubletter, så kun den første forekomst af hver firmanavn står tilbage. Giv kolonnerne fornuftige overskrifter fx Firmanavn Navn1 E-mail1, Navn2 E-mail2 osv.

Nu er de enkelste navne og e-amil adresser konverteret til felter i samme record, og dermed kan du bruge dem til den ønskede brevfletning.

Det kan være det virker lidt omstændeligt, men det virker. Her kommer koden:


Sub KombinerFirmaInfo()
Dim c As Range
Dim r As Range
Dim col As New Collection

'In Column A Firmanavne
'In Column B Navne
'In Column C E-mail adresse

For Each c In Selection.CurrentRegion.Rows
  On Error Resume Next

  'Findes firmanavner allerede på listen
  Set r = col(c.Range("A1").Text)
  If Err = 0 Then

  'Firmaet er i samlingen, se om navnet er i listen
  Err.Clear
  Call WorksheetFunction. _
        Match(c.Range("B1").Text, r.EntireRow, 0)
  If Err Then

    'Navnet er ikke på listen endnu
    With r.End(xlToRight)
      .Offset(0, 1) = c.Range("B1")
      .Offset(0, 2) = c.Range("C1")
    End With
  End If
Else

    'Tilføj et nyt firma til samlingen
    col.Add c.Range("A1"), c.Range("A1").Text
  End If
On Error GoTo 0
Next
Set col = Nothing
End Sub

Kunne du bruge det til noget?

Ja, tak for hjælpen og beklager det sene svar!

mvh

Laje

Velbekomme!