Regel met celwaarde 0 verwijderen maar lege regels laten staan

Status
Niet open voor verdere reacties.
OK, in bijgaande bijlage heb ik alles proberen samen te vatten.

In de eerste TAB staat de data die ik uit mijn systeem haal, inclusief lege kolommen inderdaad. 'originele data'

In de volgende tabs de te genereren prijslijsten te weten EURO, GBP en USD (deze heb ik ter info toegevoegd)

Deze 3 tabs moeten ieder als een aparte Excelfile met harde waarden (in de voorraad kolom D staat namelijk een vertikaal zoeken functie) opgeslagen worden.

Bij nader inzien denk ik dat een oplossing zou kunnen zijn:

Stap 1.

Kopieer de tab 'Originele Data' 3 keer naar de diverse Valuta tabbladen als harde waarden, de formules blijven intact in 'originele data'. dit is essentieel aangezien de excel vertikaal zoekt in een andere sheet. In de tab EURO moeten de EURO prijzen komen, GBP de GBP prijzen en USD de USD prijzen.

Ook een mogelijkheid is om de complete sheet 3 maal te kopieren en de data die niet nodig is te verwijderen uit de valuta sheets (deze macro's had ik al uitgevonden en staan in mijn code, deze kan ik gemakkelijk aanpassen naar de juiste tab.)

Stap 2.
Schoon de nulwaardes op uit de 3 valutatabs

Stap 3.

Sla de 3 Valuta tabbladen op als XLSX file zonder macros als afzonderlijk bestand, mét datumaanduiding in de bestandsnaam
Bij voorkeur in dezelfde map als het originele bestand.

Hoop dat ie zo duidelijk is.

Bekijk bijlage voorbeeld_update_incl_savefunctie_en_resultaat.xlsm
 
Levert jouw systeem Excel files, inclusief kleurtjes en lege regels ? of csv-files?
 
Laatst bewerkt:
Ha SNB,

bedankt voor je geduld.

Mijn systeem levert 1 grote CSV waar ik met een sjabloon/macro het bestand uit mijn voorbeeld van maak, een leesbaar bestand met inderdaad voor de duidelijkheid lege regels en kolommen. Hier hoeft niks aan gewijzigd te worden.
Deze lijst moet namelijk handmatig bewerkt worden door diverse collega's.

Ondertussen ben ik weer verder gaan klussen en heb bijgaande code er van weten te maken:

Code: 
Sub Save_various_pricelists()

'verwijder nulwaarden uit hoofdsheet

  With Range("A1:J" & Cells(Rows.Count, 1).End(xlUp).Row)
    .AutoFilter 4, 0
    .Offset(1).EntireRow.Delete
    .AutoFilter
  End With
  
  'kopieer data naar verschillende tabs

    Columns("A:S").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("prijslijst EURO").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Prijslijst GBP").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Prijslijst USD").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
'creeer prijslijsten


    Sheets("Prijslijst Euro").Range("j:s").EntireColumn.Delete

Worksheets(Array("Prijslijst Euro")).Copy
ActiveWorkbook.SaveAs Filename:="Prijslijst_Euro.xlsx " & Format(Now(), "DD-MMM-YYYY") & ".xlsx"
ActiveWorkbook.Close


    Sheets("Prijslijst GBP").Range("e:i,o:s").EntireColumn.Delete
    
    Worksheets(Array("Prijslijst GBP")).Copy
ActiveWorkbook.SaveAs Filename:="Prijslijst_GBP " & Format(Now(), "DD-MMM-YYYY") & ".xlsx"
ActiveWorkbook.Close

    Sheets("Prijslijst USD").Range("e:n").EntireColumn.Delete
    
    Worksheets(Array("Prijslijst USD")).Copy
ActiveWorkbook.SaveAs Filename:="Prijslijst_USD.xlsx " & Format(Now(), "DD-MMM-YYYY") & ".xlsx"
ActiveWorkbook.Close
End Sub

Deze code doet in principe wat ik wil met 3 kleine kanttekeningen:

- ik moet zelf de diverse valuta tabbladen aanmaken voordat het script werkt.
- de nulwaarden worden uit het blad 'originele data' geknipt voordat de data gekopieerd wordt, ik wil dit blad eigenlijk intact houden.
- de output files worden niet in dezelfde map als het originele bestand gezet

En ik denk dat het kopieergedeelte naar de diverse tabbladen veel simpeler kan, ik heb deze gecreëerd met 'macro opnemen'.
 
Dan ben ik meer benieuwd naar dat csv bestand.
Kunnen we alles buiten Excel om filteren zonder 0-waarden en per valuta.

Een combinatie van simpele Excel-formules en VBA kan ook:

Na het aanmaken van 3 bestanden met koppelingen naar het hoofdbestand kun je de tabbladen daarvoor uit het hoofdbestand verwijderen.
Code: 
Sub M_snb()
   application.displayalerts=false
   For Each it In Sheets
     If it.CodeName <> "Blad1" Then
        it.Copy
        With ActiveWorkbook
            .SaveAs "G:\OF\" & Replace(it.Name, " ", "_"), 51
            .Close 0
        End With
        it.delete 
    End If
   Next
End Sub

Het hoofdbestand bevat nu nog alleen het werkblad 'Originele data'
In het werkboek_open event zet je dan de 0-verwijderaaar.
Code: 
Private Sub Workbook_Open()
   With Blad1.UsedRange.Columns(4)
      .AutoFilter 1, 0
      .Offset(1).EntireRow.Delete
      .AutoFilter
   End With
   thisworkbook.Save
End Sub

Iedereen die daarna een van de 3 aangemaakte bestanden opent krijgt meteen de geactualieerde gegevens te zien.
 

Bijlagen

  • __globe_001.xlsb
    37 KB · Weergaven: 25
Laatst bewerkt:
Hey mensen,

ik was even offline... Weekendje Max #33 in oostenrijk ;)

Thanks voor de update, kan ik weer verder mee.

Ik krijg het alleen niet voor elkaar om de bestanden in dezelfde map als het origineel op te slaan.

Nu worden ze standaard in 'documenten' opgeslagen.

De door ons systeem gegeneerde CSV dirext te laten bewerken is geen optie, er wordt namelijk zoveel handmatig aan de lijst gewijzigd dat dit niet handig is. bv. kortingsafspraken per klant, staffels, MOQ etc.

thanks!
 
Code: 
.SaveAs .path & "\" & Replace(it.Name, " ", "_"), 51
 
er wordt namelijk zoveel handmatig aan de lijst gewijzigd dat dit niet handig is
Klik om te vergroten...

Mij lijkt het aanbrengen van wijzigingen in Excel vele malen gemakkelijker dan in een csv-bestand.
Wedje maken ? ;)
 
haha,

als jij een VBA script kan maken voor me wat automatisch checkt of:

- de overgebleven voorraad nog een uit de goede commerciële maten en kleuren bestaat
- de inkoop historie van een klant kan beoordelen
- betalingsgedrag van de klant meeneemt in de prijsafspraken
- de populariteit van een bepaald artikel kan inschatten
- weersomstandigheden checkt
- prijzen van de concurrentie verwerkt in de kortingen
- voorraad van vervangende artikelen checkt
- fingerspitzengevoel heeft

dan koop ik een krat bier voor je en een schaal bitterballen.

Als ik dit script werkend krijg ben ik al blij genoeg!

bedankt voor je antwoord.

Wellicht kun je me ook verder helpen hoe ik mijn vertikaal zoeken formules uit de cellen kan halen en 1 kolom data dmv vertikaal zoeken kan laten invullen...

Dan ben ik echt helemaal geholpen!

Dan kan ik de celwaarden uit de csv/xls laten updaten namelijk. Met een net geinstalleerde plugin kan ik sinds vandaag namelijk ook XLS exporteren.
 
Laatst bewerkt:
Wellicht kun je me ook verder helpen hoe ik mijn vertikaal zoeken formules uit de cellen kan halen en 1 kolom data dmv vertikaal zoeken kan laten invullen...
Klik om te vergroten...

Is dit een nieuwe vraag ?

zo ja: maak een nieuwe draad

zo nee: graag toelichting met toelichtend bestand.

PS. jij lijkt een heel andere ovatting te hebben van weddenschappen dan ik.
Opdrachten dienen gewoon betaald te worden; en ja al die eisen kunnen in VBA gerealiseerd worden.
 
Laatst bewerkt:
Dankzij jullie ben ik weer een stap verder maar loop tegen een dingetje aan:

Tijdens het verwijderen van de nulwaardes kan het voorkomen dat er dubbele lege regels onstaan omdat een artikel van de lijst af gaat. Heb ik in geel aangegeven in mijn voorbeeld

Wat moet er aangepast worden om de dubbele lege regel te verwijderen? Nu moet ik meerdere macro's uitvoeren terwijl het volgens mij in 1 keer kan.

code om 0 waardes te verwijderen die ik gebruik:

Code: 
With Range("A1:J" & Cells(Rows.Count, 1).End(xlUp).Row)
    .AutoFilter 4, 0
    .Offset(1).EntireRow.Delete
    .AutoFilter
  End With

Code die ik gebruik om de dubbele lege regels te verwijderen:

Code: 
Sub verwijder_dubbele_lege_regels()
    Dim i As Long, lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 9 Step -1
        If Cells(i, 1) = "" And Cells(i - 1, 1) = "" Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next
End Sub

Ik krijg het niet voor elkaar dit werkend te krijgen.
 

Bijlagen

  • voorbeeld_update_incl_savefunctie_en_resultaat3.xlsm
    23,3 KB · Weergaven: 28
Dit doet hier wat jij wil:

Code: 
Sub M_snb()
   With UsedRange
    .AutoFilter 4, 0
    .Offset(1).EntireRow.Delete
    .AutoFilter
    For Each it In Columns(1).SpecialCells(4).Areas
      If it.Rows.Count > 1 Then it.Offset(1).Resize(it.Rows.Count - 1) = "=1 / 0"
    Next
    .Columns(1).SpecialCells(-4123, 16).EntireRow.Delete
   End With
End Sub
 
Laatst bewerkt:
Ik ga checken! Na je aanpassing lijkt mij dat dit wellicht de oplossing kan zijn, je eerder aangedragen code deed het truukje niet helaas.

bedankt!
 
Snb, dank voor je bijdrage maar ik krijg een foutmelding

Fout 424
Object vereist

ik heb de macro toegepast op de file boven je antwoord.
 
Je moet de code natuurlijk wel op de goede plaats zetten.
 
Sorry SNB,

Ik krijg dat helaas niet voor elkaar met mijn prutser kennis.

In mijn onderstaande voorbeeld heb ik mijn module 2 en jouw code in module 1 gezet.
Als ik alleen jouw script draai krijg ik bovenstaande foutmelding.

Deze 2 moeten eigenlijk bij elkaar gevoegd worden.

Mijn code (die op de dubbele regels na, vlekkeloos werkt)

Code: 
Sub Save_various_pricelists()

'verwijder nulwaarden uit hoofdsheet

  With Range("A1:J" & Cells(Rows.Count, 1).End(xlUp).Row)
    .AutoFilter 4, 0
    .Offset(1).EntireRow.Delete
    .AutoFilter
  End With
  
  Dim i As Long, lr As Long
    lr = Range("A" & Rows.Count).End(xlUp).Row
    For i = lr To 9 Step -1
        If Cells(i, 1) = "" And Cells(i - 1, 1) = "" Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next
  
  'kopieer data naar verschillende tabs

    Columns("A:S").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("prijslijst EURO").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Prijslijst GBP").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Sheets("Prijslijst USD").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
        
'creeer prijslijsten


    Sheets("Prijslijst Euro").Range("j:s").EntireColumn.Delete

Worksheets(Array("Prijslijst Euro")).Copy
ActiveWorkbook.SaveAs Filename:="Prijslijst_Euro.xlsx " & Format(Now(), "DD-MMM-YYYY") & ".xlsx"
ActiveWorkbook.Close


    Sheets("Prijslijst GBP").Range("e:i,o:s").EntireColumn.Delete
    
    Worksheets(Array("Prijslijst GBP")).Copy
ActiveWorkbook.SaveAs Filename:="Prijslijst_GBP " & Format(Now(), "DD-MMM-YYYY") & ".xlsx"
ActiveWorkbook.Close

    Sheets("Prijslijst USD").Range("e:n").EntireColumn.Delete
    
    Worksheets(Array("Prijslijst USD")).Copy
ActiveWorkbook.SaveAs Filename:="Prijslijst_USD.xlsx " & Format(Now(), "DD-MMM-YYYY") & ".xlsx"
ActiveWorkbook.Close
End Sub

en jouw code die de dubbele regels moet verwijderen:

Code: 
Sub M_snb()
   With UsedRange
    .AutoFilter 4, 0
    .Offset(1).EntireRow.Delete
    .AutoFilter
    For Each it In Columns(1).SpecialCells(4).Areas
      If it.Rows.Count > 1 Then it.Offset(1).Resize(it.Rows.Count - 1) = "=1 / 0"
    Next
    .Columns(1).SpecialCells(-4123, 16).EntireRow.Delete
   End With
End Sub

Alvast waanzinnig bedankt voor je reactie.
 

Bijlagen

  • voorbeeld_update_incl_savefunctie_en_resultaat4.xlsm
    23,7 KB · Weergaven: 32
Je hebt niets met mijn suggestie in #34 gedaan. Reden ?
 
snb zei:
Je hebt niets met mijn suggestie in #34 gedaan. Reden ?
Klik om te vergroten...

zekers... Ik ben een prutser en heb geen idee waar hem te zetten.

Vandaar dat ik er 2 modules van gemaakt heb.
 
Zet hem/haar in de macromodule van het werkblad waarop de code betrekking heeft.
 
en hoe doe ik dat?

Ik zie nu dit scherm waarbij Module 2 jouw code is.


Knipsel.PNG
 
Moet toch echt naar Blad1, niet in een aparte Macromodule.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan