ga naar extra->macro->visual basic editorquote:Op woensdag 17 januari 2007 13:22 schreef Meeldraad het volgende:
@ Ralphies oplossing:
Hoe maak ik een worksheet_onchange macro? Dit is hoe ik het geprobeerd heb: Extra => Macro => Nieuwe macro opnemen => naamgeven, OK => stopknop. Vervolgens in Macro's bewerken heb ik alles geselecteerd en jouw scriptje eroverheen geplakt. Daarna heb ik A1:A100 vervangen door B3 (aangezien er maar een cel is waarin je de geboortedatum moet invullen). Misschien heb ik een fout gemaakt, maar het resultaat is in ieder geval geen streepjes en de rekencellen rekenen er niet mee. Een voorbeeld van een rekencel is dit:
Waar heb je die datums die je invoert dan allemaal al staan?quote:Op woensdag 17 januari 2007 14:27 schreef Meeldraad het volgende:
@ Arcee
Klopt die oplossing was ook werkzaam, maar als je weet hoeveel verwijzingen ik dan handmatig zou moeten omzetten, daar wordt je niet blij van, komt nog eens bij dat de formules nog ondoorzichtiger worden dan ze al zijn en als er ergens toch nog fouten inzitten wordt het nog lastiger ze op te sporen. De formules moeten zo gestroomlijnd mogelijk zijn. En zoals gezegd lost het niet alle problemen op.
Daar maak je dan weer een aparte ALS voor. In jouw Nederlandse versie zou dat dan zo moeten worden:quote:Het invoeren van een datum mét streepjes leidt tot foute waarden.
1 2 3 4 | Application.Goto Reference:="R65536C[0]" Selection.End(xlUp).Select End Sub |
1 2 3 4 | Application.Goto Reference:="R1C[0]" If ActiveCell.Value = "" Then Selection.End(xlDown).Select End Sub |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 | Dim Mark As Integer Dim Marker, Markcolor As String Marker = InputBox("Welke tekenreeks (getal of string) staat in de te markeren cel?", "Merkteken") If Marker = "" Then Exit Sub Markcolor = InputBox("Welke kleur markering? (rood, groen, blauw, geel, roze)", "Markerkleur", "rood") bool = Markcolor = "rood" Or Markcolor = "groen" Or Markcolor = "blauw" Or Markcolor = "geel" Or Markcolor = "roze" If bool = False Then Exit Sub If Markcolor = "rood" Then Mark = 3 If Markcolor = "groen" Then Mark = 4 If Markcolor = "blauw" Then Mark = 5 If Markcolor = "geel" Then Mark = 6 If Markcolor = "roze" Then Mark = 7 Do Until ActiveCell.Value = "" If ActiveCell = Marker Then ActiveCell.Interior.ColorIndex = Mark If CStr(ActiveCell.Value) = Marker Then ActiveCell.Interior.ColorIndex = Mark ActiveCell.Offset(1, 0).Range("a1").Select Loop End Sub |
ja, de cel geeft het nu als tekst weer. Om met deze tekst als datum te werken, moet je de functie DATUMWAARDE gebruiken, bijvquote:Op woensdag 17 januari 2007 14:27 schreef Meeldraad het volgende:
@ralfie
Oké gelukt, en inderdaad maakt het nu niet uit of ik ze met of zonder streepje invoer, uiteindelijk staan ze er zoals ik ze wil zien. A sight for sore eyes! Alleen de rekencellen doen er nog niks mee. Moet ik misschien een andere verwijzing gebruiken dan in mijn vorige post?
1 |
Zie m'n profiel. Je hebt zo te zien je PM niet geactiveerd.quote:Op donderdag 18 januari 2007 12:01 schreef Meeldraad het volgende:
PM maar een mailadres bij belangstelling.
Het probleem is dat een illegale datum door excel niet kan worden omgezet en dan kun je er in visual basic ook niks mee.Maar na wat experimenteren net iets uitgevonden. Cell.value2 geeft de ingevoerde waarde, ook als deze geen legale datum is. De aangepaste code wordt dan:quote:Op donderdag 18 januari 2007 12:01 schreef Meeldraad het volgende:
@ ralfie
Dat is nog een relatief kleine toevoeging... even testen....
Wauw, ik geloof dat dit een oplossing is waar ik mee kan leven! Het is niet zo te regelen dat de celeigenschap al op datum staat en dat je vervolgens via een macro het hele streepverhaal bewerkstelligt? (Zoals gezegd, ik wil de formules zo kort mogelijk houden)
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 | If Not Intersect(Range("A1:A100"), Target) Is Nothing Then On Error GoTo wrong Dim vale As String, length As Integer For Each cell In Target length = Len(cell.Value2) If length = 7 Or length = 8 And Not length = 0 Then If length = 7 Then vale = "0" & cell.Value2 Else vale = cell.Value2 End If cell.Value = DateValue(Left$(vale, 2) & "-" & Mid$(vale, 3, 2) & "-" & Right$(vale, 4)) End If Next cell End If Exit Sub wrong: MsgBox "De ingevulde waarde: '" & vale & "' is geen geldige datum!" End Sub |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 | ' Deze macro kijkt of de cel onder de active cell dezelfde waarde bevat. ' Zo ja dan wordt deze verwijderd, anders wordt er verder gegaan Do While ActiveCell.Value <> "" Curr = ActiveCell.Value ActiveCell.Offset(1, 0).Range("A1").Select Do Application.CutCopyMode = False Selection.Delete Shift:=xlUp Loop While ActiveCell.Value = Curr Loop End Sub |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | ' ' Deze macro verwijderd duplicaten uit een ongesorteerde kolom ' Hierbij wordt bovenaan begonnen Do While ActiveCell.Value <> "" Check = ActiveCell.Value rij = ActiveCell.Row kol = ActiveCell.Column Do While ActiveCell.Value <> "" ActiveCell.Offset(1, 0).Range("a1").Select If ActiveCell.Value = Check Then Selection.Delete Shift:=xlUp Else: End If Loop 'activecell weer terug naar check cell en 1 cel naar beneden en do -loop Range("a1").Select ActiveCell.Offset(rij, kol - 1).Range("a1").Select Loop End Sub |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 | Dim arr() As Integer Dim vals() As Variant Dim number As Integer number = ThisWorkbook.Sheets("blad1").UsedRange.Count ReDim arr(number, 2) ReDim vals(number) Dim x For Each cell In ThisWorkbook.Sheets("blad1").UsedRange If Not cell.Value = "" Then arr(x, 1) = cell.Column arr(x, 2) = cell.Row vals(x) = cell.Value x = x + 1 End If Next cell ThisWorkbook.Sheets("blad2").Activate Dim drow As Integer, dcol As Integer For y = 0 To x - 1 dcol = arr(y, 1) - 2 If dcol < 1 Then dcol = 1 drow = arr(y, 2) * 3 If arr(y, 1) = 1 Then drow = drow - 2 ElseIf arr(y, 1) = 2 Then drow = drow - 1 End If Cells(drow, dcol).Value = vals(y) Next y End Sub |
Hehe, ik slaap in het weekend. Maar Ralfie is een betere coder dan ik en die heeft op zondag niets te doen zo te zienquote:Op zondag 21 januari 2007 00:32 schreef realbase het volgende:
Deetch need your help again
Forum Opties | |
---|---|
Forumhop: | |
Hop naar: |