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

Verplaatsen tekst

Status
Niet open voor verdere reacties.
X

xbox360

Gebruiker
Lid geworden
7 nov 2008
Berichten
498
Hoi,

ik heb een kleine vraagje, ik maak een export van een bij plaatsing app
nu zit er een cel bij of het schoon of opgeruimd is
is het misschien mogelijk? als ik deze inplak dat hij uit cel A1 de tekst automatische overzet naar B1 en de tekst schoon verdwijnt uit cel A1?
alvast super bedankt
 

Bijlagen

  • test export.xlsx
    10,5 KB · Weergaven: 36
Zowel vraagstelling als voorbeeldbestand geven mij geen idee wat je bedoelt. Wat plak je waar?
 
@SjonR

Cel A1 tot A29 komt uit de export

en A32 tot B59 is een voorbeeld hoe het uit zou moeten zien
 
Probeersel. In de module van het werkblad.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cl As Range
    
    If Target.Column <> 1 Then Exit Sub
    Application.EnableEvents = False
    For Each Cl In Target
        If LCase(Cl.Value) = "schoon" Then
            Cl.Offset(, 1) = Cl
            Cl.ClearContents
        End If
    Next
    Application.EnableEvents = True
End Sub
 
@Timshel
het werkt perfect met een nieuwe excel blad
als ik deze in de excel file gebruik waar die eigenlijk thuis hoort
krijg een Compileerfout
Er is een dubbelzinnige naam gevonden: Worksheet_change
er eens reeds een vba met de formule
is dit te onzeilen? of moet het dan via een formule in de cellen?
Alvast super bedankt
 
Kennelijk bestaat er al een Worksheet_Change-routine in dat werkblad. Als die routine functionaliteit bevat die behouden moet blijven moet hij uitgebreid worden. Plaats de bestaande routine hier en vergeet de code-tags niet.
 
ik heb er twee instaan

Private Sub Worksheet_Change(ByVal Target As Range)
r = Range("A" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("D6:N" & r)) Is Nothing Or Target.Count > 1 Then Exit Sub
tc = Target.Column
tr = Target.Row
With Sheets("Planning")
Set b1 = .Cells(tr, tc).Offset(-4, 4)
Set b2 = .Cells(tr, tc).Offset(-4, 5)
If Target.Value <> "" Then b1.Value = "a" Else b1.Value = ""
If Target.Value <> "" Then b2.Value = Date Else b2.Value = ""
End With
End Sub
 
en deze staat erin

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each cell In Range("G2:G10000")
If cell.Value = "" And cell.Offset(0, -5).Value <> "" And cell.Offset(0, 7).Value = "" And cell.Offset(0, 8).Value = "" Then cell.Value = "o.b.v. melding"
Next cell
For Each cell In Range("D2:D10000")
If cell.Value = "" And cell.Offset(0, 10).Value = "" And cell.Offset(0, 11).Value = "" And cell.Offset(0, 3).Value = "o.b.v. melding" Then cell.Value = "extra"
Next cell
Application.EnableEvents = True
r = Range("A" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("D6:J" & r)) Is Nothing Or Target.Count > 1 Then Exit Sub
tc = Target.Column
tr = Target.Row
With Sheets("Planning")
Set b1 = .Cells(tr, tc).Offset(-4, 4)
Set b2 = .Cells(tr, tc).Offset(-4, 5)
If Target.Value <> "" Then b1.Value = "a" Else b1.Value = ""
If Target.Value <> "" Then b2.Value = Date Else b2.Value = ""
End With
End Sub
 
Ik heb je gevraagd om codetags te gebruiken.
 
Sorry, voor jou een super makkelijke antwoord
maar voor mijn iets anders
hoe gebruik ik codetags?
 
Kijk eens in de knoppenbalk boven het tekstvak <Snel reageren, naar de derde knop van rechts (#). Kwestie van je code selecteren, en op de knop drukken.
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
r = Range("A" & Rows.Count).End(xlUp).Row
If Intersect(Target, Range("D6:N" & r)) Is Nothing Or Target.Count > 1 Then Exit Sub
tc = Target.Column
tr = Target.Row
With Sheets("Planning")
Set b1 = .Cells(tr, tc).Offset(-4, 4)
Set b2 = .Cells(tr, tc).Offset(-4, 5)
If Target.Value <> "" Then b1.Value = "a" Else b1.Value = ""
If Target.Value <> "" Then b2.Value = Date Else b2.Value = ""
End With
End Sub

Zoiets
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each cell In Range("G2:G10000")
If cell.Value = "" And cell.Offset(0, -5).Value <> "" And cell.Offset(0, 7).Value = "" And cell.Offset(0, 8).Value = "" Then cell.Value = "o.b.v. melding"
Next cell
For Each cell In Range("D2:D10000")
If cell.Value = "" And cell.Offset(0, 10).Value = "" And cell.Offset(0, 11).Value = "" And cell.Offset(0, 3).Value = "o.b.v. melding" Then cell.Value = "extra"
Next cell
Application.EnableEvents = True
r = Range("A" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("D6:J" & r)) Is Nothing Or Target.Count > 1 Then Exit Sub
    tc = Target.Column
    tr = Target.Row
    With Sheets("Planning")
        Set b1 = .Cells(tr, tc).Offset(-4, 4)
        Set b2 = .Cells(tr, tc).Offset(-4, 5)
        If Target.Value <> "" Then b1.Value = "a" Else b1.Value = ""
        If Target.Value <> "" Then b2.Value = Date Else b2.Value = ""
    End With
End Sub
 
Welke van deze routines staat achter het werkblad waar het om gaat?
 
deze staat in tabblad 2018

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
For Each cell In Range("G2:G10000")
If cell.Value = "" And cell.Offset(0, -5).Value <> "" And cell.Offset(0, 7).Value = "" And cell.Offset(0, 8).Value = "" Then cell.Value = "o.b.v. melding"
Next cell
For Each cell In Range("D2:D10000")
If cell.Value = "" And cell.Offset(0, 10).Value = "" And cell.Offset(0, 11).Value = "" And cell.Offset(0, 3).Value = "o.b.v. melding" Then cell.Value = "extra"
Next cell
Application.EnableEvents = True
r = Range("A" & Rows.Count).End(xlUp).Row
    If Intersect(Target, Range("D6:J" & r)) Is Nothing Or Target.Count > 1 Then Exit Sub
    tc = Target.Column
    tr = Target.Row
    With Sheets("Planning")
        Set b1 = .Cells(tr, tc).Offset(-4, 4)
        Set b2 = .Cells(tr, tc).Offset(-4, 5)
        If Target.Value <> "" Then b1.Value = "a" Else b1.Value = ""
        If Target.Value <> "" Then b2.Value = Date Else b2.Value = ""
    End With
End Sub
 
Vervang hem eens door deze:
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cl As Range
    
    Application.EnableEvents = False
    For Each Cl In Range("G2:G10000")
        If Cl.Value = "" And Cl.Offset(, -5).Value <> "" And Cl.Offset(, 7).Value = "" And Cl.Offset(, 8).Value = "" Then Cl.Value = "o.b.v. melding"
    Next
    For Each Cl In Range("D2:D10000")
        If Cl.Value = "" And Cl.Offset(, 10).Value = "" And Cl.Offset(, 11).Value = "" And Cl.Offset(, 3).Value = "o.b.v. melding" Then Cl.Value = "extra"
    Next
    If Target.Column = 1 Then
        For Each Cl In Target
            If LCase(Cl.Value) = "schoon" Then
                Cl.Offset(, 1) = Cl
                Cl.ClearContents
            End If
        Next
    End If
    Application.EnableEvents = True
    If Intersect(Target, Range("D6:J" & Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Or Target.Count > 1 Then Exit Sub
    Set Cl = Sheets("Planning").Range(Target.Address).Offset(-4, 4)
    If Target.Value <> "" Then
        Cl.Value = "a"
        Cl.Offset(, 1) = Date
    Else
        Cl.Resize(, 2).ClearContents
    End If
End Sub
 
@Timshel
Werkt perfect alleen nog een heel klein vraagje
had de C1 al aangepast maar werkt jammer genoeg niet
ik plak de export in CEL E1, maar als ik de C1 naar E1 veranderd gebeurt er jammer genoeg niks
als dit nu nog naar CEL E1 makkelijk veranderd kan worden is het gewoon super
 
@Timshel
dat het een vast geven is dat het alleen maar werkt als je de export in cel A1 plakt.
en als ik de export plak in cel E1 werkt het niet:(
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan