• 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.

macro starten na een als formule

Status
Niet open voor verdere reacties.

eef2135

Gebruiker
Lid geworden
8 dec 2008
Berichten
10
Vraagje
Ik gebruik een als formule
'=ALS(B14>5;enz

wat ik wil is dat als de waarde groter is dan 5 dan moet een macro starten
als de waarde kleiner is dan 5 hoeft er niets te gebeuren
kan dat en zo ja hoe
Dank je wel voor je hulp
 
dank je wel voor je antwoord Piet
ik zal het wel niet goed begrijpen "maar niet vragen is nog dommer"

toch nog een vraag moet ik jouw "hele oplossing" in mijn macro plaatsen
of kan dat door jouw tekst te veranderen in de naam van mijn macro

bijgevoegt heb ik wat ik nu heb
wat ik dus wil is dat op blad 1 alles >5 weg gehaald word
dank je wel voor je hulp
Everard
 

Bijlagen

Eef,

Waar je de code vandaan hebt weet ik niet maar een aantal vraagtekens zijn op hun plaats.
Onderstaande code moet je plaatsen in de VBE onder je blad naar keuze.
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    Dim calcmode As Long
    Dim ViewMode As Long

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With
  With Sheets("blad2")
            .Select
                 Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For Lrow = Lastrow To Firstrow Step -1
                      With .Cells(Lrow, "b")
                If Not IsError(.Value) Then
                If .Value > 5 Then .EntireRow.Delete
                    End If
            End With
        Next Lrow
    End With
    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With
End Sub

Ik heb aan de code niets gewijzigd en het werkt en dat is het voornaamste.

Kijk op het plaatje waar je het moet plaatsen.

Grtz.
 

Bijlagen

  • Screenshot.jpg
    Screenshot.jpg
    85,5 KB · Weergaven: 129
dank je wel

dank je wel voor je antwoord ik ga er mee stoeien:thumb:
 
vraag

Hallo SuperZeeuw
Ik ben wat aan het spelen met jouw oplossing.en uit je antwoord begrijp ik dat er een "simpeler manier" is om deze macro te maken
En wil eigelijk nog een tweede voorwaarde toevoegen voor dat de makro uitgevoerd word
Asl b14>5 en c14 = 10
Enig idee
Dank je wel voor je hulp
 
Eef,

Probeer onderstaande code eens.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Firstrow As Long
    Dim Lastrow As Long
    Dim Lrow As Long
    
    Application.ScreenUpdating = False
    With ActiveSheet
        Firstrow = .UsedRange.Cells(1).Row
        Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
        For Lrow = Lastrow To Firstrow Step -1
            If Cells(Lrow, "b").Value > 5 And Cells(Lrow, "c").Value = 10 Then Rows(Lrow).Delete
        Next Lrow
    End With
    Application.ScreenUpdating = True
End Sub

Zijn er nog vragen dan hoor ik het wel.

Grtz.
 
Laatst bewerkt:
Of deze (snelheid van uitvoering)

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
    sq = ActiveSheet.UsedRange
        For j = LBound(sq) To UBound(sq)
            If Cells(j, "B").Value > 5 And Cells(j, "C").Value = 10 Then Rows(j).Delete
        Next
    Application.ScreenUpdating = True
End Sub

Mvg

Rudi
 
even wachten

Hallo Heren
allereerst bedankt voor het "mee denken"
Even een berichtje via een internet cafe pc

Aangezien ik een probleem heb met mijn standaard pc (hij ruste in vrede):evil:
zal vandaag een nieuwe kopen,dan alles weer instaleren enz
m.a.w het zal even een paar dagen duren voor ik bijde oplossingen kan testen
en jullie wat kan laten weten
fijne paasdagen
Eef
 
Verbetering op code van Rudi.
Deze code is sneller omdat de verwerking van een matrix-variabele sneller gaat dan het uitlezen van cellen.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
    sq = ActiveSheet.UsedRange
    For j = LBound(sq) To UBound(sq)
      If [COLOR="Blue"]sq[/COLOR](j, 2) > 5 And [COLOR="blue"]sq[/COLOR](j, 3) = 10 Then Rows(j).Delete
    Next
    Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
SNB,

Dank voor de uitleg.

Ik krijg al mijn problemen wel opgelost met langzame en lange codes maar jouw codes zijn zo kort, en krachtig heel leuk om te zien en heel erg leerzaam.
Het zal wel even duren alvorens ik ze geïmplementeerd heb maar ik neem ze van harte mee.

Ik merk heel goed het verschil in snelheid in de codes die jij gebruikt en die ik gebruik.

Grtz.
 
vervolg op jullie antwoorden

Hallo Heren
Ik heb weer een pc in de lucht dus kon jullie oplossingen testen
Het is toch niet helemaal wat ik bedoelde
In mijn voorbeeld heeft het blad Bon slecht 2 waardes (6 en 10 )
(Maar in de praktijk kan Het blad Bon meerdere willekeurige waarde(s) hebben

de"gevonden waardes" moeten dan alleen gewist worden in het blad opslag
De rest in het blad opslag moet dan blijven staan
Dank je wel voor je hulp
 

Bijlagen

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
   Application.ScreenUpdating = False
    sq =sheets("Bon").UsedRange.columns(2)
    For j = 1 To UBound(sq)
      sheets("Opslag").columns(1).replace sq(j, 1),""
    Next
    sheets("Opslag").specialcells(xlcelltypeblanks).entirerow.delete
    Application.ScreenUpdating = True
End Sub
 
Laatst bewerkt:
errorwoord

Dank je wel voor je snelle antwoord
Of ik doe wat verkeert ,maar ik krijg de volgende error
in zin na
NEXT
Sheets("Opslag").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
zie bijgevoegd bestand

Dank je wel voor de hulp
 

Bijlagen

Laatst bewerkt:
Deze had je ook zelf kunnen vinden:

Code:
Sub celwissen()
   Application.ScreenUpdating = False
    sq = Sheets("Bon").Columns(2).SpecialCells(xlCellTypeConstants)
    For j = 1 To UBound(sq)
      Sheets("Opslag").Columns(1).Replace sq(j, 1), ""
    Next
    Sheets("Opslag")[COLOR="Red"].Columns(1)[/COLOR].SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Application.ScreenUpdating = True
End Sub
 
dank je wel

Dank je wel voor je hulp
ik had het niet zo snel gezien wat er fout zat
het werkt inderdaad zo als ik wilde
:thumb:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan