Stickers voor verkochte auto's maken

Status
Niet open voor verdere reacties.

mysticsilent

Gebruiker
Lid geworden
10 okt 2008
Berichten
27
Hoi Allemaal,

Ik ben niet zo heel erg thuis in Visual basic maar kan de logische volgorde van het bestand aardig zien.
Wat doet hij nu. Hij opent 2 bestanden met gegevens.

Bestand 1 is een tabel met kolommen waarin auto gegevens staan: Kenteken, Merk, Type, Kleur, Carroserievorm, Datum binnenkomst en Datum aflevering.

Bestand 2 is een tabel met kolommen waarin verkoop gegevens staan: Ordernummer, Orderdatum, Klantnr, Klantnaam, Kenteken en verkoper.

Wat hij precies doet snap ik nog niet helemaal maar het komt er op neer dat hij kolommen uit bestand 2 gaat kopieren in een nieuw bestand en deze gaat aanvullen met kolommen uit bestand 1 (autogegevens) waarbij hij vergelijkt op kentekennummer. De rest filtert hij er dus uit.

Daarna slaat hij het op als Stickers.XLS en dit bestand kan ik gaan gebruiken in word door middel van samenvoegen naar bestand om ze op een stickervel te gaan printen.

-------------------

Nu wil ik een extra kolom toevoegen in bestand 2 genaamd "Verwijderd".
Is er een mogelijkheid om deze kolom ook te laten invoegen in het bestand en dan tegelijk kan laten filteren op een waarde? In deze kolom bestaan namelijk maar 2 soorten waarden. True of False.
Ik wil graag dat hij alleen de regels met de waarde False gaat toevoegen, en daarna direct de gehele kolom verwijderd aangezien deze niet op de sticker vermeld gaat worden maar puur als enige filter mogelijkheid dient.

(Waarde False zijn dus de orders die nog niet verwijderd of gefactureerd zijn namelijk).



----------------


Dit is de code die ik nu momenteel heb draaien zonder enige aanpassing:

Code:
Sub StickersOpenFileDefinitie()
    Workbooks.Open Filename:="C:\Lijsten klaar zetten\Stickers\Autostickers.xls"
    Workbooks.Open Filename:="C:\Lijsten klaar zetten\Stickers\Ordersstickers.xls"
End Sub
Sub StickersOrderOpmaak()
    Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
    Columns("B:B").Select
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 4), TrailingMinusNumbers:=True
    Selection.NumberFormat = "dd/mm/yy"
    Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(0, 1), TrailingMinusNumbers:=True
    Range("A2").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:= _
        Range("B2"), Order2:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
        DataOption3:=xlSortNormal
    Range("F1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Merk"
    Range("G1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Type"
    Range("H1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Kleur"
    Range("I1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Soort"
    Range("J1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Binnen dd"
    Range("K1").Select
    Selection.EntireColumn.Insert
    ActiveCell.FormulaR1C1 = "Aflev dd"
    Range("F2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-1],'Autostickers.XLS'!C1:C7,2,FALSE)"
    Range("G2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-2],'Autostickers.XLS'!C1:C7,3,FALSE)"
    Range("H2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-3],'Autostickers.XLS'!C1:C7,4,FALSE)"
    Range("I2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-4],'Autostickers.XLS'!C1:C7,5,FALSE)"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-5],'Autostickers.XLS'!C1:C7,6,FALSE)"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = _
        "=VLOOKUP(RC[-6],'Autostickers.XLS'!C1:C7,7,FALSE)"
    Range("F2:K2").Select
    Selection.Copy
    Range("L1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(0, -6).Range("A1").Select
    Range(Selection, Selection.End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Columns("F:K").Select
    Selection.Copy
    Range("F1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2").Select
    Selection.Sort Key1:=Range("A2"), Order1:=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
        xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, _
        DataOption3:=xlSortNormal
End Sub
Sub StickersAfsluiten()
    Windows("Autostickers.XLS").Activate
    ActiveWorkbook.Close
    Windows("OrdersSTICKERs.XLS").Activate
    ChDir "C:\Lijsten klaar zetten\Stickers"
    ActiveWorkbook.SaveAs Filename:="C:\Lijsten klaar zetten\Stickers\STICKERS.XLS", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
End Sub

--------------

En dit is de module waarmee ik de macro laat uitvoeren:

Code:
Sub Stickers()
    Application.DisplayAlerts = False
    StickersOpenFileDefinitie
    StickersOrderOpmaak
    StickersAfsluiten
    Application.DisplayAlerts = True
End Sub
 
Laatst bewerkt:
Opgelost.. Heb het kunnen maken door de functie 'Marco opnemen' in excel. mag een slotje op
 
... En dat mag je zelf doen! Je hebt boven in de blauwe menubalk een optie om de vraag op Opgelost te zetten.
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan