• 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 dan functie

Status
Niet open voor verdere reacties.
Kan het liggen dat ik nu op apple werk?
 
Laatst bewerkt:
Ga met de cursor op de eerste regelcode staan en druk F9.
Verlaat de VB-editor en verander A30.
Nu ga je stap voor stap met F8 door de code om te kijken wat de code doet.
 
hij doet het nu wel haha apart, Hartelijk dank

Mag ik je nog iets vragen? In kolomQ staat een datum tijd, is het mogelijk om deze zodanig te maken dat je zonder spaties gewoon het jaar maand dat T etc Z krijgt. dus door gewoon dooor te typen 20180320T135850Z moeten ook hoofdletters zijn met de scheidingstekens. worst dan 2018-03-20T13:58:50Z
 
Ik hou niet van dat gepruts, toe maar.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A29:A36,H29:H36,J29:K36,Q30:Q36")) Is Nothing Or Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  Select Case Target.Column
    Case 1
      If Target = "TRANSACTIE" Then
        Target.Offset(, 2) = "NEWT"
        Target.Offset(, 11) = "NL"
      End If
    Case 17
      Target = UCase(Target)
      Target = Left(Target, 4) & "-" & Mid(Target, 5, 2) & "-" & Mid(Target, 7, 3) & Mid(Target, 10, 2) & ":" & Mid(Target, 12, 2) & ":" & Mid(Target, 14, 2) & Right(Target, 1)
    Case Else
      If Target <> "" Then Target = Cells(Range("F17:F23").Find(Target.Value).Row, 2)
   End Select
 
  Application.EnableEvents = True
End Sub
 
Harry,
Mag ik je nog een keer hierover lastigvallen omdat hij in de sheet op de zaak niet werkt en ik een foutmelding krijg. Ik heb de ranges aangepast aan de juiste ranges in de uiteindelijke sheet.
Ik krijg een compileerfout: Er is een dubbelzinnige naam gevonden: Worksheet_change

Kun jij aangeven of- en hoe ik dat kan oplossen. Zoals je ziet is het vet gedrukte een andere, eerdere, opdracht, weet niet of ik iets moet toevoegen of aanpassen

Code: 
[B]Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("H77:H105,J77:K105,AG77:AH105")) Is Nothing Or Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  If Target <> "" Then Target = Cells(Range("F12:F70").Find(Target.Value).Row, 2)
  Application.EnableEvents = True
End Sub[/B]

Private Sub Worksheet_Change(ByVal Target As Range)
  If Intersect(Target, Range("A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub
  Application.EnableEvents = False
  Select Case Target.Column
    Case 1
      If Target = "TRANSACTIE" Then
        Target.Offset(, 2) = "NEWT"
        Target.Offset(, 11) = "NL"
Target.Offset(, 4) = " 7245002Y5RHYB096BK53"
        Target.Offset(, 5) = "yes"
Target.Offset(, 6) = " 7245002Y5RHYB096BK53"
        Target.Offset(, 13) = "false"
Target.Offset(, 27) = " NL"
        Target.Offset(, 37) = "false"
Target.Offset(, 38) = "false"

      End If
    Case 17
      Target = UCase(Target)
      Target = Left(Target, 4) & "-" & Mid(Target, 5, 2) & "-" & Mid(Target, 7, 3) & Mid(Target, 10, 2) & ":" & Mid(Target, 12, 2) & ":" & Mid(Target, 14, 2) & Right(Target, 1)
    Case Else
      If Target <> "" Then Target = Cells(Range("F17:F23").Find(Target.Value).Row, 2)
   End Select
 
  Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Hoewel ik niet Harry ben, toch een antwoord....;-)

Je gebruikt twee keer
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
, terwijl dit per werkblad maar één keer mag.

Je zult dus van die twee subs één moeten maken.
 
Wellicht zo?
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H77:H105,J77:K105,AG77:AH105")) Is Nothing Or Target, Range("A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target <> "" Then Target = Cells(Range("F12:F70").Find(Target.Value).Row, 2)
Application.EnableEvents = False
Select Case Target.Column
Case 1
If Target = "TRANSACTIE" Then
Target.Offset(, 2) = "NEWT"
Target.Offset(, 11) = "NL"
Target.Offset(, 4) = " 7245002Y5RHYB096BK53"
Target.Offset(, 5) = "yes"
Target.Offset(, 6) = " 7245002Y5RHYB096BK53"
Target.Offset(, 13) = "false"
Target.Offset(, 27) = " NL"
Target.Offset(, 37) = "false"
Target.Offset(, 38) = "false"

End If
Case 17
Target = UCase(Target)
Target = Left(Target, 4) & "-" & Mid(Target, 5, 2) & "-" & Mid(Target, 7, 3) & Mid(Target, 10, 2) & ":" & Mid(Target, 12, 2) & ":" & Mid(Target, 14, 2) & Right(Target, 1)
Case Else
If Target <> "" Then Target = Cells(Range("F17:F23").Find(Target.Value).Row, 2)
End Select

Application.EnableEvents = True
End Sub
 
Thanks,
Ik krijg een compileerfout: Syntaxisfout. Denk ik deze regel omdat die rood kleurt

Code: 
If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105")) Is Nothing Or Target, Range("A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub
 
Laatst bewerkt:
Code: 
If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105")) Is Nothing Or Target, Range("A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub

moet zijn
Code: 
If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105")) Is Nothing Or [COLOR="#FF0000"]Intersect([/COLOR]Target, Range("A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub
 
Sorry, maar krijg eenzelfde foutmelding bij deze regel. Zal de hele formule nogmaals plaatsen.
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105")) Is Nothing Or Intersect(Target, Range("A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target <> "" Then Target = Cells(Range("F12:F70").Find(Target.Value).Row, 2)
Application.EnableEvents = False
Select Case Target.Column
Case 1
If Target = "TRANSACTIE" Then
Target.Offset(, 2) = "NEWT"
Target.Offset(, 11) = "NL"
Target.Offset(, 4) = "7245002Y5RHYB096BK53"
Target.Offset(, 5) = "yes"
Target.Offset(, 6) = "7245002Y5RHYB096BK53"
Target.Offset(, 13) = "false"
Target.Offset(, 27) = "NL"
Target.Offset(, 37) = "false"
Target.Offset(, 38) = "false"

End If
Case 17
Target = UCase(Target)
Target = Left(Target, 4) & "-" & Mid(Target, 5, 2) & "-" & Mid(Target, 7, 3) & Mid(Target, 10, 2) & ":" & Mid(Target, 12, 2) & ":" & Mid(Target, 14, 2) & Right(Target, 1)
Case Else
If Target <> "" Then Target = Cells(Range("F17:F23").Find(Target.Value).Row, 2)
End Select

Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Zou het kunnen dat de groen gedrukte then Exit Sub niet voor case 1 moet staan, de rood gemarkeerde tekst maakt onderdeel uit van de code die erboven staat. Het lijkt net of deze er nu niet bij hoort. Al wordt ik niet gehinderd door al te veel kennis over VB.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105")) Is Nothing Or Intersect(Target, Range("A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 [COLOR=#00ff00][B]Then Exit Sub[/B][/COLOR]
Application.EnableEvents = False
[COLOR=#ff0000]If Target <> "" Then Target = Cells(Range("F12:F70").Find(Target.Value).Row, 2)
Application.EnableEvents = False
Select Case Target.Column[/COLOR]
Case 1
If Target = "TRANSACTIE" Then
Target.Offset(, 2) = "NEWT"
Target.Offset(, 11) = "NL"
Target.Offset(, 4) = "7245002Y5RHYB096BK53"
Target.Offset(, 5) = "yes"
Target.Offset(, 6) = "7245002Y5RHYB096BK53"
Target.Offset(, 13) = "false"
Target.Offset(, 27) = "NL"
Target.Offset(, 37) = "false"
Target.Offset(, 38) = "false"

End If
Case 17
Target = UCase(Target)
Target = Left(Target, 4) & "-" & Mid(Target, 5, 2) & "-" & Mid(Target, 7, 3) & Mid(Target, 10, 2) & ":" & Mid(Target, 12, 2) & ":" & Mid(Target, 14, 2) & Right(Target, 1)
Case Else
If Target <> "" Then Target = Cells(Range("F17:F23").Find(Target.Value).Row, 2)
End Select

Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
wellicht zo?

Code: 
If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105","A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub
 
nee helaas krijg weer foutmelding op de geel gearceerde regel

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR=#ffd700]If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105", "A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then[/COLOR] Exit Sub
Application.EnableEvents = False
If Target <> "" Then Target = Cells(Range("F12:F70").Find(Target.Value).Row, 2)
Application.EnableEvents = False
Select Case Target.Column
Case 1
If Target = "TRANSACTIE" Then
Target.Offset(, 2) = "NEWT"
Target.Offset(, 11) = "NL"
Target.Offset(, 4) = "7245002Y5RHYB096BK53"
Target.Offset(, 5) = "yes"
Target.Offset(, 6) = "7245002Y5RHYB096BK53"
Target.Offset(, 13) = "false"
Target.Offset(, 27) = "NL"
Target.Offset(, 37) = "false"
Target.Offset(, 38) = "false"

End If
Case 17
Target = UCase(Target)
Target = Left(Target, 4) & "-" & Mid(Target, 5, 2) & "-" & Mid(Target, 7, 3) & Mid(Target, 10, 2) & ":" & Mid(Target, 12, 2) & ":" & Mid(Target, 14, 2) & Right(Target, 1)
Case Else
If Target <> "" Then Target = Cells(Range("F17:F23").Find(Target.Value).Row, 2)
End Select

Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Verwijder:
Code: 
[COLOR=#FFD700]", "[/COLOR]
en plaats een...
Code: 
[COLOR="#FFFF00"],[/COLOR]
terug.
 
zelfde foutcode, zelfde plaats

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H78:H105,J78:K105,AG78:AH105,A78:A105,C78:C105,E78:G105,N78:N105,AB78:AB105,AL78:AM105,Q78:105")) Is Nothing Or Target.Count > 1 Then Exit Sub
Application.EnableEvents = False
If Target <> "" Then Target = Cells(Range("F12:F70").Find(Target.Value).Row, 2)
Application.EnableEvents = False
Select Case Target.Column
Case 1
If Target = "TRANSACTIE" Then
Target.Offset(, 2) = "NEWT"
Target.Offset(, 11) = "NL"
Target.Offset(, 4) = "7245002Y5RHYB096BK53"
Target.Offset(, 5) = "yes"
Target.Offset(, 6) = "7245002Y5RHYB096BK53"
Target.Offset(, 13) = "false"
Target.Offset(, 27) = "NL"
Target.Offset(, 37) = "false"
Target.Offset(, 38) = "false"

End If
Case 17
Target = UCase(Target)
Target = Left(Target, 4) & "-" & Mid(Target, 5, 2) & "-" & Mid(Target, 7, 3) & Mid(Target, 10, 2) & ":" & Mid(Target, 12, 2) & ":" & Mid(Target, 14, 2) & Right(Target, 1)
Case Else
If Target <> "" Then Target = Cells(Range("F17:F23").Find(Target.Value).Row, 2)
End Select

Application.EnableEvents = True
End Sub
 
Laatst bewerkt:
Gebruik codetags rondom je code en plaats het bestand.
 
Moest even zoeken wat codetags waren op het internet.Bekijk bijlage test trans 120318.xlsm

Ik hoop dat je dit bedoelde ik heb de ranges weer aangepast zodat die bij het voorbeeld passen.

Het gaat dus om 3 verschillende codes
Om in o.a. H30, J30 K30 AG30 , AH30 de naam te selecteren uit Kolom F12:F22 en uiteindelijk het nummer uit B12:B22 te krijgen
in A30:A36 bij Transactie een aantal velden ingevuld te krijgen met de standaard data
in Q30 de data voor de opmaak van jjjmmdd etc.
 
Die codetags moet je niet in je code plaatsen, maar op het forum als je een code plaatst.

Wat zal er hier fout zijn?
Code: 
Range("H30:H36,J30:K36,AG30:AH36,A30:A36,C30:C36,E30:G36,N30:N36,AB30:AB36,AL30:AM36,Q30:36")

En 'Or' wordt 'And'.
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan