Cellen verplaatsen afhankelijk van de waarde

[hryttel]

Beste helpers!

Ik zit een tijdje te worstelen met het volgende.
Ik heb een werkblad met diverse tabbladen en een ervan beval tijden (voor het berekenen van gemiddelden en andere doeleinden.
In kolom D heb ik de tijd duur in minuten staan en als die boven 60 min. komt wil ik de inhoud verplaatst hebben naar kolom K. (op de zelfde regel)

Ik heb geprobeerd met een marco, dat wil niet dan word de gehele kolom verplaats.
Ik heb soort gelijke vragen opgezocht en daar de VBA geprobeerd aan te passen aan mijn wens, is ook niet gelukt.

Alle suggesties zijn welkom.

MVG, Henning
Bekijk bijlage Gemiddelde tijd min groter dan 60.xlsx

 

[Cobbe]

Is het niet beter om uw gemiddelde-formule aan te passen aan de situatie dan gegevens te willen verplaatsen met de nodige foutrisico's.

=ALS.FOUT(SOMPRODUCT(($D$6:$D$9999<=60)*($H$6:$H$9999=KOLOM())*($D$6:$D$9999))/SOMPRODUCT(($D$6:$D$9999<=60)*($H$6:$H$9999=KOLOM()));"")

Of deze als je dat liever hebt:

=ALS.FOUT(SOMMEN.ALS($D$6:$D$9999;$D$6:$D$9999;"<=60";$H$6:$H$9999;KOLOM())/AANTALLEN.ALS($D$6:$D$9999;"<=60";$H$6:$H$9999;KOLOM());"")

 

[namliam]

Wil je de hele waarde verplaatsen of kan de waarde ook blijven staan?
In het tweede geval kan je het af met de volgende formule in kolom K

=ALS(D6>60,D6,"")

In het eerste geval heb je de volgende VBA nodig:

Sub test()
    Dim r As Double
    For r = 6 To 9999
        If Cells(r, 4) > 60 Then
            Cells(r, 10) = Cells(r, 4)
            Cells(r, 4).ClearContents
        End If
        
    Next r
End Sub

 

[hryttel]

Goedemorgen Cobbe en Namliam,

Cobbe, Wat zijn de foutrisico's?

Namliam, welke commando moet je geven om de VBA te laten werken.

Groeten,
Henning

 

[Cobbe]

Elke onnodige manipulatie met gegevens kan fouten veroorzaken.

Ik heb een button en de nodige code in je bestand gezet.

 

[Cobbe]

Het kan ook zonder button, enkel als een waarde > 60 ingegeven wordt --> verplaatsing.

 

[hryttel]

Cobbe,

Dank je wel! Ik ga straks ermee spelen en laat dan asap weten.

Groeten,
Henning

 

[hryttel]

Cobbe,

Kan het zijn dat het niet werkt als ik een Macro heb voor een andere functie op een andere tabblad in het zelfde document?
Kan het helpen als de naam van de tabblad opgenomen word in de VBA?

Sub DatumZtijd()
'
' DatumZtijd Macro
' Datum tijd notitie aanpassen in alleen Datum dd-mmm-jj
'
' Sneltoets: Ctrl+d
'
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "=DAY(RC[-20])&-MONTH(RC[-20])&-YEAR(RC[-20])"
    Range("U2").Select
    Selection.AutoFill Destination:=Range("$U$2:$U$9999"), Type:=xlFillDefault
    Range("$U$2:$U$9999").Select
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Replace What:="0-1-1900", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
End Sub

Ps kan deze Macro ook in VBA?


Groeten,
Henning

 

[Cobbe]

Neen, geen conflict.

andere functie op een andere tabblad

Deze macro vormt geen probleem als hij maar niet gedraaid wordt in hetzelfde werkblad als waarin je die andere code hebt staan.

 

[hryttel]

Cobbe,

In het oorspronkelijke document krijg ik de "Gemiddelde tijd min groter dan 60_automatisch.xlsm" niet aan de gang.
Ik denk toch dat de Macro die hier in Blad 11 gebruikt word, de VBA die in Blad 6 in de zelfde werkmap, in de weg zit.
De versie die je heb gemaakt met knop werkt wel, toch wil ik het liefst automatisch als het samen kan gaan.

Groeten,
Henning

 

[hryttel]

Cobbe,

Ik heb zit puzzelen en jij hebt gelijk, het werkt (bij handmatig invoeren van waarden >60 in de cel)!
Bij grote hoeveelheid data over kopiëren krijg ik deze fout melding:



Gr, Henning

 

[Cobbe]

Ik kan hier niet inschatten wat jij allemaal wil doen als je me dat niet laat weten,
De code reageert enkel op een wijziging in kolom D.
Nu spreek je van grote hoeveelheden cellen die gewijzigd worden, dat vereist een andere aanpak.

Voor die foutmelding kan je de rode tekst(code) tussenvoegen:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Double
If Not Intersect(Target, Range("D6:D" & Range("D" & Rows.Count).End(xlUp).Row)) Is Nothing Then
  [B][/B][COLOR="#FF0000"] If Not Target.Count > 1 Then[/COLOR]
    If Target > 60 Then
            Target.Cut Cells(Target.Row, 11)
    End If
   [COLOR="#FF0000"][/COLOR][B]End If[/B]End If
End Sub

Wat deze code moet doen snap ik niet zo goed:

Sub DatumZtijd()
'
' DatumZtijd Macro
' Datum tijd notitie aanpassen in alleen Datum dd-mmm-jj
'
' Sneltoets: Ctrl+d
'
    With Range("U2")
        .FormulaLocal = "=DAG($A$2)&-MAAND($A$2)&-JAAR($A$2)"
        .AutoFill Destination:=Range("$U$2:$U$9999"), Type:=xlFillDefault
    End With
    Range("$U$2:$U$9999").Copy
    Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Cells.Replace What:="0-1-1900", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False
    
End Sub

 

[hryttel]

Goedemorgen Cobbe,

Ik heb een document waar ik diverse rapportages samenvat tot een overzicht.

Ik krijg elke dag een overzicht die ik in dit rapport samenvoegt, dus elk dag komt er ± 100 gesprekstijden bij. Ik meet de gemiddelde gesprekstijd en wil alles boven 60 min uitfilteren voor naarder coaching.
In het zelfde document op een andere tabblad heb ik andere rapportages waar de aangeleverde tijd format verschillend is en om te kunnen vergelijken (in verschillende rapporten) heb het zelfde tijd format nodig. Dat wordt door de Macro gedaan, het kan wellicht ook in VBA.
Om het zelfde tijd format te krijgen heb ik in de Macro staan "=DAG($A$2)&-MAAND($A$2)&-JAAR($A$2)" in een kolom buiten de normale gegevens bereik. Vervolgens copier ik de inhoud terug in de datum kolom. Als dat gedaan is kan in weer een andere tabblad een vergelijking uitvoeren.

=ALS(ISFOUT(INDEX(Care!$F$2:$F$9922;VERGELIJKEN(B612&C612;Care!$A$2:$A$9922&Care!$E$2:E$9922;0)));"";INDEX(Care!$F$2:$F$9922;VERGELIJKEN(B612&C612;Care!$A$2:$A$9922&Care!$E$2:E$9922;0)))

Het zou misschien verstandiger zijn al deze rapporten in ieder zijn eigen werkmap uit te werken en een werkmap met alle uitkomsten.

Het probleem is als ik een aantal regels over kopieert van een andere rapport, dan krijg ik de fout melding.
Voor alsnog ben ik erg blij met de VBA met kopje, bedankt hiervoor.

Groeten,
Henning

 

[hryttel]

Cobbe,

Voor alsnog ben ik erg blij met de VBA met kopje, bedankt hiervoor. :thumb:
Voor zover is het opgelost.


Groeten,
Henning