Met behulp van macro's automatisch kolommen verwijderen en toevoegen.

[JulianDerks]

Goedendag,

Ik heb een probleem die ik niet zelf kan oplossen.
Wij hebben een ERP-systeem waaruit wij tabellen kunnen exporteren naar excel.

Probleem
het komt vaak voor dat de tabellen die zijn geëxporteerd naar Excel onoverzichtelijk zijn door meerdere onnodige kolommen.
daarbij is het vaak nodig om zelf kolommen te maken die bijvoorbeeld 2 andere kolommen van elkaar aftrekken.

Mijn vraag
Is het mogelijk dat met behulp van macro's meerdere kolommen met een druk om de knop worden verwijderd terwijl er ook 1 automatisch wordt toegevoegt?
Het lastige is dat de plaats van de kolommen nog wel eens kan verschillen. dus ze moeten worden herkend aan de titel die ze krijgen op regel 1. en aan de hand van de titel worden ze dan wel/niet verwijderd.

hieronder het bestand voor en na waar het om gaat.

Bestand voor
In het rood staat aangegeven welke kolommen automatisch verwijderd moeten worden

Bekijk bijlage huidige situatie na export van tabel.xls



Bestand Na
In het groen staat een kolom aangegeven die automatisch moet worden toegevoegd. deze kolom trekt 2 andere kolommen van elkaar af. (zie bestand)

Bekijk bijlage Gewenste situatie met behulp van Macro.xls

 

[spaarie]

Denk dat dit het makkelijkst is. Zo kan je altijd nog kolommen toevoegen uit de verwijder selectie of juist uitsluiten.

Sub Spaarie()
    With ActiveSheet
        For c = .UsedRange.Columns.Count To 1 Step -1
            Select Case .Cells(1, c)
                Case "VKRegel", "PCF", "ProdBOMProdDossierCode", "VKSubregel", "Fiat werkvoorbereiding", "OrdnrProblem", _
                     "DosDetProblem", "PDProblem", "Geprojecteerde voorraad", "ProdBOMProdDossEndDate", "DiffPurchase", _
                     "Datum gereed", "Opmerking", "Verdeling herkomst inkoop", "Hoofdgroepcode", "Artikelgroep"
                .Columns(c).Delete xlLeft
                Case Else
                'doe niks...
            End Select
        Next
        .Columns(14).Insert xlRight
        .Cells(1, 14).Value = "Dagen te laat"
        For Each cl In .Columns(13).SpecialCells(2).Offset(1).SpecialCells(2)
            cl.Offset(, 1).Value = Format(cl.Offset(, 4).Value, "0") - Format(cl.Value, "0")
        Next
    End With
End Sub

EDIT: Complete code.

 

[JulianDerks]

Super!

Dankje!

 

[JulianDerks]

Spaarie,

Nog een vraag.


Ik wil via voorwaardelijke opmaak de data in een kolom roodmaken wanneer dit in het verleden is.
Nu lukt het niet als ik aangeef <VANDAAG()

Dit komt omdat de datum notatie dat in de betreffende kolom staat genoteerd
DD/MM/JJJJ is ipv de DD/M/JJJJ die nodig is. er staat bv 11/03/2015 in plaats van 11/3/2015
nu kan ik via =DATUMWAARDE de datum als DD/M/JJJJ krijgen.

Ook hierna wil het kolom niet reageeren op de voorwaardelijke opmaak.

Hoe kan ik ervoor zorgen dat de data in het verleden als rood wordt weergeven.

Hieronder het bestand. hier kun je concreet zien om welke kolom het gaat (GEEL)

Bekijk bijlage voorwaardelijke opmaak.xlsm

 

[spaarie]

Ik vermoed eerder dat het niet werkt omdat de 'datums' als tekst staan genoteerd. Dit komt waarschijnlijk doordat het geëxporteerd is vanuit het ERP pakket.
In onderstaande code is opgenomen dat alle 'datums' die in kolom M staan ook daadwerkelijk een datum worden. Wellicht dat het probleem hiermee opgelost is.

Sub Spaarie()
    With ActiveSheet
        For c = .UsedRange.Columns.Count To 1 Step -1
            Select Case .Cells(1, c)
                Case "VKRegel", "PCF", "ProdBOMProdDossierCode", "VKSubregel", "Fiat werkvoorbereiding", "OrdnrProblem", _
                     "DosDetProblem", "PDProblem", "Geprojecteerde voorraad", "ProdBOMProdDossEndDate", "DiffPurchase", _
                     "Datum gereed", "Opmerking", "Verdeling herkomst inkoop", "Hoofdgroepcode", "Artikelgroep"
                .Columns(c).Delete xlLeft
                Case Else
                'doe niks...
            End Select
        Next
        .Columns(14).Insert xlRight
        .Cells(1, 14).Value = "Dagen te laat"
        For Each cl In .Columns(13).SpecialCells(2).Offset(1).SpecialCells(2)
            [COLOR="#FF0000"][U]cl.Value = CDate(cl.Value)[/U][/COLOR]
            cl.Offset(, 1).Value = Format(cl.Offset(, 4).Value, "0") - Format(cl.Value, "0")
        Next
    End With
End Sub

 

[JulianDerks]

Beste spaarie,

Bedankt voor je hulp!

ik heb alleen een foutje gemaakt en zou graag nog een keer je hulp willen vragen:

zoals ik in het begin zei was het gewenst om de kolommen op titel te verwijderen. dit heb jij mooi toegepast.
ik heb zelf de macro's voor de voorwaardelijke opmaak(datum in verleden = rood) en de sortering van hoog naar laag proberen te maken door middel van opname.
hier ben ik helemaal vergeten dat dit ook op titel moet, ik heb de kolom geselecteerd.

hoe moet ik de code ordenen om hem goed werkend te krijgen waarin en de voorwaardelijke opmaak over de kolom met titel ''ProdBOMPDPartLineRcptDate'' gaat en de sortering over kolom ''Dagen te laat''

zie hieronder de code: KOLOM M:M = ProdBOMPDPartLineRcptDate / KOLOM N:N = ''Dagen te laat''


Sub Filter()
'
' Filter Macro
'
With ActiveSheet
For c = .UsedRange.Columns.Count To 1 Step -1
Select Case .Cells(1, c)
Case "VKRegel", "PCF", "ProdBOMProdDossierCode", "VKSubregel", "Fiat werkvoorbereiding", "OrdnrProblem", _
"DosDetProblem", "PDProblem", "Geprojecteerde voorraad", "ProdBOMProdDossEndDate", "DiffPurchase", _
"Datum gereed", "Opmerking", "Verdeling herkomst inkoop", "Hoofdgroepcode", "Artikelgroep"
.Columns(c).Delete xlLeft
Case Else
'doe niks...
End Select
Next
.Columns(14).Insert xlRight
.Cells(1, 14).Value = "Dagen te laat"
For Each cl In .Columns(13).SpecialCells(2).Offset(1).SpecialCells(2)
cl.Value = CDate(cl.Value)
cl.Offset(, 1).Value = Format(cl.Value, "0") - Format(cl.Offset(, 4).Value, "0")
Next
End With

Columns("N:N").Select
ActiveWorkbook.ActiveSheet.Sort.SortFields.Clear
ActiveWorkbook.ActiveSheet.Sort.SortFields.Add Key:=Range _
("N1"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.ActiveSheet.Sort
.SetRange Range("A2:R401")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

Columns("M:M").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
Formula1:="=0"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
.Pattern = xlNone
.TintAndShade = 0
End With

Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlLess, _
Formula1:="=VANDAAG()"
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Font
.Color = -16383844
.TintAndShade = 0
End With

With Selection.FormatConditions(1).Interior
.PatternColorIndex = xlAutomatic
.Color = 13551615
.TintAndShade = 0
End With

Selection.FormatConditions(1).StopIfTrue = False
End Sub

 

[spaarie]

De VO kan je alternatief inbouwen in de VBA code door een simpele If-statement toe te voegen. Mijn vraag is dus of het wenselijk is om dit met VO te doen of met de code...
Hier zit alles in verwerkt:

Sub Spaarie()
    Application.ScreenUpdating = False
    With ActiveSheet
        For c = .UsedRange.Columns.Count To 1 Step -1
            Select Case .Cells(1, c)
                Case "VKRegel", "PCF", "ProdBOMProdDossierCode", "VKSubregel", "Fiat werkvoorbereiding", "OrdnrProblem", _
                     "DosDetProblem", "PDProblem", "Geprojecteerde voorraad", "ProdBOMProdDossEndDate", "DiffPurchase", _
                     "Datum gereed", "Opmerking", "Verdeling herkomst inkoop", "Hoofdgroepcode", "Artikelgroep"
                .Columns(c).Delete xlLeft
                Case Else
                'doe niks...
            End Select
        Next
        .Columns(14).Insert xlRight
        .Cells(1, 14).Value = "Dagen te laat"
        For Each cl In .Columns(13).SpecialCells(2).Offset(1).SpecialCells(2)
            cl.Value = CDate(cl.Value)
            cl.Offset(, 1).Value = Format(cl.Offset(, 4).Value, "0") - Format(cl.Value, "0")
            If cl.Value < CDate(Date) Then cl.Interior.Color = RGB(255, 0, 0) 'rood kleuren
        Next
        .Cells.CurrentRegion.Sort [N2], xlDescending 'sorteren
    End With
    Application.ScreenUpdating = True
End Sub

 

[OctaFish]

@Julian: kijk eens naar de code van spaarie en vergelijk die eens met je eigen code in bericht #6. Code moet je opmaken met de CODE knop om hem netjes leesbaar te houden met inspringen etc. Kun je jouw code alsnog netjes opmaken? Je kunt ook (de knop CODE zit alleen in Geavanceerde weergave) de tekst [ CODE ] vóór de code typen en de tekst [ /CODE] erachter (maar zonder de spaties, anders werkt de tag niet).