Formule keuze nieuwsbrief

[jli]

Hallo Excellers,

Iedere week verstuur ik zo'n 500 nieuwsbrieven.
Dit doe ik voornamelijk handmatig maar omdat ik steeds meer aanmeldingen krijg, wil ik het automatiseren.

Bezoekers kunnen aangeven in welke supermarkten zij interesse hebben en aan de hand van die voorkeur
ontvangen zij een nieuwsbrief. Maar niet elke week heeft elke supermarkt een biologische aanbieding.

In mijn voorbeeld bestandje staan in kolom A e-mailadressen, en in de andere kolommen
staan de supermarkten met of zonder een kruisje waarvan ze op de hoogte gehouden willen worden.

NB. Ieder e-mail adres krijgt een nieuwsbrief met 2 aanbiedingen van 2 verschillende supermarkten toegestuurd.

Ik maak bijvoorbeeld per week 5 varianten van de nieuwsbrief, bijvoorbeeld:
Nieuwsbrief 1 Albert Heijn - C1000
Nieuwsbrief 2 Emte - Jumbo
Nieuwsbrief 3 Jan Linders - Nettorama

Nu moet de formule kijken welke e-mailadressen nieuwsbrief 1 ontvangen.
in dit geval regel 2,6,26
(Omdat er bij Albert Heijn en C1000 allebij een x staat.)
Deze 3 e-mailadressen moet komen in blad2 in a1 achter elkaar gezet, gescheiden door een ;
De volgende nieuwsbrief nr. 2: regel 2,15,19,23 en 27
(Omdat er bij Emte en Jumbo allebij een x staat.)
Maar omdat hier het emailadres van regel 2 al gebruikt is voor nieuwsbrief 1, wordt deze overgeslagen.
Nieuwsbrief nr. 3: regel 2,3,4,5,6,7,8 en 10
Maar omdat de emailadressen van regel 2,6,15,19 en 27 al gebruikt zijn voor nieuwsbrieven 1 en 2 wordt voor
nieuwsbrief 3 alleen de emailadressen van regel 3 en 4 gebruikt

Alle emailadressen hebben nu een variant aangewezen gekregen behalve het emailadres van a9.
De emailadressen die niet ingedeeld kunnen worden in 1 van de 3 varianten ontvangt altijd de eerste variant.

Wie kan aan de hand van deze uitleg een formule maken ?

Jurgen

 

[robdgr]

Jurgen,

38 keer bekeken, maar nog geen reactie zegt misschien iets over je vraagstelling. Niettemin maak ik je attent op een code van Wigi, waarmee je in ieder geval handmatig kunt samenvoegen:

Sub cellenSamenvoegen()
'  ______________________________________________________________________________
' |                                                                              |
' |  Wim Gielis                                                                  |
' |  wimmekegielis@hotmail.com                                                   |
' |  05/05/2007, revised 07/02/2007                                              |
' |  Custom module to join the contents of cells and put them in                 |
' |         Immediate Window and also on the Clipboard                           |
' |  Also on http://www.wimgielis.be                                             |
' |______________________________________________________________________________|


'voorafgaande noot: om de samengevoegde cellen naar het Klembord te kopiëren moet je bij
'Tools > References... (Extra > Verwijzing) een vinkje zetten bij Microsoft Forms 2.0 object library

    Dim rng As Range
    Dim lAantal As Long
    Dim rLegeCellen As Range
    Dim arrSamen() As String
    Dim sScheiding As String
    Dim sSamengevoegd As String
    Dim MyDataObj As New DataObject
    Dim sKlembordGelukt As String
    
    On Error Resume Next
    Set rLegeCellen = Selection.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    
    If Not rLegeCellen Is Nothing Then
        If rLegeCellen.Count = Selection.Count Then
            MsgBox "Je hebt enkel lege cellen geselecteerd. De macro stopt hier.", vbInformation, Application.UserName
        End If
    Else
        sScheiding = Application.InputBox("Geef het scheidingsteken op aub." & vbNewLine & vbNewLine & "(Je mag " _
            & "bijvoorbeeld ook , typen gevolgd door een spatie of zelfs dit vak leeglaten)", "Scheidingsteken", _
            ",", Type:=2)
        
        lAantal = 0
        
        'array inlezen
        For Each rng In Selection
            lAantal = lAantal + 1
            ReDim Preserve arrSamen(lAantal)
            arrSamen(lAantal) = rng.Text
        Next
        
        'de tekst samenvoegen
        sSamengevoegd = Join(arrSamen, sScheiding)
        
        'het scheidingsteken aan het begin niet meenemen
        sSamengevoegd = Right(sSamengevoegd, Len(sSamengevoegd) - Len(sScheiding))
        
        'de samengevoegde tekst naar het Immediate Window overbrengen
        Debug.Print sSamengevoegd & vbNewLine
        
        'de samengevoegde tekst naar het Klembord overbrengen
        On Error GoTo 0
        MyDataObj.SetText sSamengevoegd
        MyDataObj.PutInClipboard
        
        If Err.Number = 0 Then sKlembordGelukt = " en ook op het Klembord"
        On Error GoTo 0
        
        MsgBox lAantal & " cellen werden samengevoegd" & vbNewLine & vbNewLine & "De inhoud van de samengevoegde " _
            & "cellen staat nu in het Immediate Window in VBE" & sKlembordGelukt, vbInformation, Application.UserName
    End If
End Sub