• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

als er een 0 staat dan cel leeg maken met de voorgaande cel

  • Onderwerp starter Onderwerp starter ewh
  • Startdatum Startdatum
Status
Niet open voor verdere reacties.
E

ewh

Gebruiker
Lid geworden
7 jul 2010
Berichten
288
met VBA gaan we een reeks gegevens, van dezelfde bij elkaar optellen en plaatsen in kolom K en L
helaas geeft de laatste rij bij de uren een 0 waarde ( door de opbouw van de gegevens )
als in L 0 uren staan dan willen we dat niet zien even als de gegevens in kolom K
hoelang de rij gegevens is weten we niet van te voren maar de nulwaarde van de uren staat altijd onder aan.
wie weet daar een vba regel voor

K L
bestemming uren
35 - test 14
35 - bewoner 2
35 - morgen 5 5
35 - test 3 3
35 - morgen 1 6
35 - bewoner 3 2
35 - nog eentje 4
35 - 45001234 4
35 - 0
 
Ik ben uitgegaan van het voorbeeld in je eerdere vraag.
Code: 
Sub hsv()
Dim sn, i As Long, Odic As Object
sn = Sheets("blad1").Cells(2, 1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
      If sn(i, 2) > 0 Then Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
   Next i
Sheets("Blad1").Cells(3, 16).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
End Sub
 
Laatst bewerkt:
HSV
klopt je opmerking is nog steeds het zelfde prgje.

ik heb het voorbeeld bestandje verder uitgebreid , want jou oplossing geeft geen verschil met de eerdere oplossing die ik heb gehad van je
in kolom C kunnen max. 227 regels staan klom C wordt gevuld met de waarde die in D2 staat

wil jij nog eens kijken ?

Bekijk bijlage voorbeeld 0 weg en verplaatsen.xls
 
HSV zei:
Ik ben uitgegaan van het voorbeeld in je eerdere vraag.
Code: 
Sub hsv()
Dim sn, i As Long, Odic As Object
sn = Sheets("blad1").Cells(2, 1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
     [COLOR="#0000FF"] If sn(i, 2) > 0 [/COLOR]Then Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
   Next i
Sheets("Blad1").Cells(3, 16).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
End Sub
Klik om te vergroten...

Dit staat niet in mijn code toch?
Code: 
[COLOR="#0000FF"]If sn(i, 3) > 0 [/COLOR]

Het ging om de uren die op nul stonden, en de uren staan in kolom B (sn(i,2).
 
HSV zei:
Dit staat niet in mijn code toch?
Code: 
[COLOR="#0000FF"]If sn(i, 3) > 0 [/COLOR]

Het ging om de uren die op nul stonden, en de uren staan in kolom B (sn(i,2).
Klik om te vergroten...

je hebt gelijk, ik maak een denk fout ( dacht dat ik je code begreep)
net getest en werkt prima , bedankt

heb je ook een oplossing voor de twee de vraag die in het voorbeeldje staat ??
 
Zoiets dus.
Code: 
Sub hsv()
Dim sn, i As Long, Odic As Object,dic as object
With Sheets("blad1")
sn = .Cells(2, 1).CurrentRegion
 Set Odic = CreateObject("scripting.dictionary")
 Set dic = CreateObject("scripting.dictionary")
    For i = 3 To UBound(sn)
     If sn(i, 2) > 0 And Left(sn(i, 1), 2) <> "45" Then Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
     If sn(i, 2) > 0 And Left(sn(i, 1), 2) = "45" Then dic.Item(sn(i, 3) & " - " & sn(i, 1)) = dic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
    Next i
  .Cells(3, 11).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
  .Cells(3, 14).Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
 End With
End Sub
 
Laatst bewerkt:
HSV zei:
Zoiets dus.
Code: 
Sub hsv()
Dim sn, i As Long, Odic As Object,dic as object
With Sheets("blad1")
sn = .Cells(2, 1).CurrentRegion
 Set Odic = CreateObject("scripting.dictionary")
 Set dic = CreateObject("scripting.dictionary")
    For i = 3 To UBound(sn)
     If sn(i, 2) > 0 And Left(sn(i, 1), 2) <> "45" Then Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
     If sn(i, 2) > 0 And Left(sn(i, 1), 2) = "45" Then dic.Item(sn(i, 3) & " - " & sn(i, 1)) = dic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
    Next i
  .Cells(3, 11).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
  .Cells(3, 14).Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
 End With
End Sub
Klik om te vergroten...

top op zich werkt hij prima een vraag nu kijken we naar kolom A maar we moeten kijken naar kolom K
en als er geen waarde is die 45 bevat dan krijg ik een foutmelding op je laatste regel.
als de celeln zijn verplaatst dan mag de waarde weg in kolom K
de code heb ik nog niet lekker door vandaar deze simpele vraag ( sorry )
 
Laatst bewerkt:
Plaats het bestand eens met kolom K.

De fout is als er geen gegevens zijn en is makkelijk te omzeilen.
Code: 
If Odic.Count > 0 Then .Cells(3, 11).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
  If dic.Count > 0 Then .Cells(3, 14).Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))

Niet steeds onnodig quoten aub. het maakt deze pagina alleen maar onoverzichtelijk en lang.
 
Laatst bewerkt:
Waarom moet er nu naar kolom K gekeken worden terwijl de code het resultaat van de eerste 3 kolommen al geeft.
 
HSV zei:
Waarom moet er nu naar kolom K gekeken worden terwijl de code het resultaat van de eerste 3 kolommen al geeft.
Klik om te vergroten...

omdat ik eerst een routine uitvoer waar alles wordt samen gevoegd in kolom K .
dus daar staan nu ook de 45 nummers in ( zie voorbeeldje )
stel dat we dat oplossen dan zijn we er
 
Je hebt beide codes, dus ik zie het probleem niet zo.
Je kan ze na elkaar uitvoeren en het resultaat laten zien in andere cellen dan in de code staat.

Zo bekom je alle vier de staatjes (naast elkaar of onder elkaar).
 
klopt ik voer de beide codes ook na elkaar uit
doch zal in kolom K ook de waarde met 45 erin staan
de kolom K wordt gekopieerd en in een andere groet sheet gebruikt en apart wordt de kolom N
gekopieerd en die komt in een andere sheet te staan

dus op een of andere manier moet in kolom K de waarde waar 45 in staat verdwijnen
 
Wordt met de hand gekopieerd?
 
Dan kopieer je een van de twee staatjes met Vba en doet daarna een clearcontents.
Of je schrijft een van de twee staatjes direct naar dat grote sheet.
Lijkt me niet echt moeilijk.

Niet dat ik niet nog een keer een code wil aandragen, maar om het zo makkelijk mogelijk te houden.
Als dat echt niet kan zal ik er morgen nog eens opnieuw induiken.
 
ik heb hetecht geprobeerd maar gaat niet lukken , kan je me nog een keer helpen ?
 
Code: 
Sub met_45()
Dim sn, i As Long, Odic As Object
With Sheets("blad1")
.Cells(1, 11).CurrentRegion.Offset(2).Resize(, 5).ClearContents
sn = .Cells(2, 1).CurrentRegion
Set Odic = CreateObject("scripting.dictionary")
  For i = 3 To UBound(sn)
      If sn(i, 2) > 0 Then Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
   Next i
    .Cells(3, 11).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
 End With
End Sub
Code: 
Sub zonder_45()
Dim sn, i As Long, Odic As Object, dic As Object
With Sheets("blad1")
.Cells(1, 11).CurrentRegion.Offset(2).Resize(, 5).ClearContents
sn = .Cells(2, 1).CurrentRegion
 Set Odic = CreateObject("scripting.dictionary")
 Set dic = CreateObject("scripting.dictionary")
    For i = 3 To UBound(sn)
     If sn(i, 2) > 0 And Left(sn(i, 1), 2) <> "45" Then Odic.Item(sn(i, 3) & " - " & sn(i, 1)) = Odic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
     If sn(i, 2) > 0 And Left(sn(i, 1), 2) = "45" Then dic.Item(sn(i, 3) & " - " & sn(i, 1)) = dic.Item(sn(i, 3) & " - " & sn(i, 1)) + sn(i, 2)
    Next i
  If Odic.Count > 0 Then .Cells(3, 11).Resize(Odic.Count, 2) = Application.Transpose(Array(Odic.keys, Odic.items))
  If dic.Count > 0 Then .Cells(3, 14).Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
 End With
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan