hulp gezocht voor macro

[knoop1982]

Goedenmorgen,

Ik ben al een tijd bezig geweest om een macro te schrijven, maarja als leek mis je toch veel dus zou wat hulp zeer welkom zijn...

In de bijlagen staat een voorbeeld hoe ik het wilt hebben.

Mijn probleem ligt bij de selectie van Start week dus krijg je een getal binnen en een getal met Eind week die wil ik in een range hebben om die 1-tjes en gele kleur toe te voegen op die rij... Dus de juiste rij moet ook meegegeven worden.

Geef alstublieft mij een hint om verder te komen...
Hier wat ik tot nu hebt:

Sub Knoop()
Dim Rng As Range
Dim Cell1 As Range
Dim Cell2 As Range
Dim c
With Selection.Font
keus = Application.InputBox(prompt:="Druk 1 als u de tabel wilt vullen met 1-en en een kleur geel", Type:=1)
If keus = 1 Then
Set Cell1 = Application.InputBox(prompt:="Geef Start week", Type:=8)
Set Cell2 = Application.InputBox(prompt:="Geef Eind week", Type:=8)
'hier 2 ranges in 1 range zetten(Rng)
For Each c In Rng
c.Value = 1 'Zet in alle geslecteerde cellen een 1
c.Interior.ColorIndex = 6 'Kleur geel
End If
Next c
Else
MsgBox "Er is iets fout gegaan"
End If
End With
End Sub

Ik w8 met smart op een antwoord.

Groet,
Knoop

 

[Roncancio]

Hallo,

Persoonlijk zou ik het zo doen:

'
' Jaap Macro
' De macro is opgenomen op 4-4-2007 door Jeroen Strik.
'
' Sneltoets: CTRL+SHIFT+J
'
    With Selection.Font
        While IsNumeric(C1) = False Or C1 = ""
            C1 = Application.InputBox("Geef Start week")
        Wend
        While IsNumeric(C2) = False Or C2 = ""
             C2 = Application.InputBox("Geef Eind week")
        Wend
        Rij = Range("A65536").End(xlUp).Row + 1
        Range("A" & Rij) = C1
        Range("B" & Rij) = C2
        
        With Range("C2:IV2")
            Set CB = .Find(C1)
            Set CE = .Find(C2)
        End With
        Range(Chr(64 + CB.Column) & Rij & ":" & Chr(64 + CE.Column) & Rij).Value = 1
        Range(Chr(64 + CB.Column) & Rij & ":" & Chr(64 + CE.Column) & Rij).Interior.ColorIndex = 6
            
    End With

Bovenstaande code vraagt om een begin en eindweek.
Er moet een getal worden ingevoerd. Gebeurd dat niet dan wordt er opnieuw naar gevraagd.
Vervolgens wordt gezocht naar de laatst ingevulde cel in de A-kolom.
Daarna wordt gekeken waar de weken staan in de 2e rij.
Tenslotte wordt het bereik beginweek tot eindweek gevuld met 1'en en achtergrondkleur "geel".

Ieder programmeert op z'n/haar manier maar ik zou wel zo min mogelijk gebruik maken van lussen omdat die traag zijn.

Met vriendelijke groet,


Roncancio

 

[knoop1982]

helemaal top dat je zo snel kan reageren met een bijna volledig antwoord

Wat er nu gebeurd is je geef inderdaad begin en eind week op maar die 1-en en die gele kleur komen niet op dezelfde regel als waar je geslecteerd hebt... je zet ze namelijk onder de laatste ingevoerde data van begin en eind week...

voor de rest heb je mij top geholpen... ik gaat nog effe knutselen

ciao

 

[Roncancio]

Hallo,

Zo dan ?

Sub Jaap()
'
' Jaap Macro
' De macro is opgenomen op 4-4-2007 door Jeroen Strik.
'
' Sneltoets: CTRL+SHIFT+J
'
    With Selection.Font
        While IsNumeric(C1) = False Or C1 = ""
            C1 = Application.InputBox("Geef Start week")
        Wend
        While IsNumeric(C2) = False Or C2 = ""
             C2 = Application.InputBox("Geef Eind week")
        Wend
        Rij = ActiveCell.Row 
        Range("A" & Rij) = C1
        Range("B" & Rij) = C2
        
        With Range("C2:IV2")
            Set CB = .Find(C1)
            Set CE = .Find(C2)
        End With
        Range("C" & Rij & ":" & "IV" & Rij).Clear
        Range(Chr(64 + CB.Column) & Rij & ":" & Chr(64 + CE.Column) & Rij).Value = 1
        Range(Chr(64 + CB.Column) & Rij & ":" & Chr(64 + CE.Column) & Rij).Interior.ColorIndex = 6
            
    End With
End Sub

In plaats dat de gegevens op de onderste regel worden geplaatst, gebeurd dat nu in de regel waar de cursor staat. Voor de rest is er niets veranderd.

Met vriendelijke groet,


Roncancio

 

[Wigi]

Roncancio

ipv

Range(Chr(64 + CB.Column) & Rij & ":" & Chr(64 + CE.Column) & Rij).Value = 1

doe je beter

Range(Cells(Rij, CB.Column), Cells(Rij, CE.Column)).Value = 1

Analoog in de laatste regel.

Je moet wel testen of C1 en/of C2 gevonden werden.

Wigi

 

[knoop1982]

Start Eind
week week 1 2 3 4 5 6 7
1 8
1 6
2 7
3 7
4 9
4 10
4 6
2 7 1 1 1 1 1 1
Dit is mijn uitvoer........
Hij zet nog steeds alles op de laatste rij waar nog data staat dus waar start week 2 en eind week 7 staat met die 1-en stond eerst start week 5 en eind week 7
en er zit nog een bug bij de eerste met start week 1 eind week 8, hij vind die 1 niet lekker als begin getal....

 

[Roncancio]

Hallo,

De 1'en zoekt hij bij mij wel goed nu.
Ik neem aan bij jou ook.

Sub Jaap()
'
' Jaap Macro
' De macro is opgenomen op 4-4-2007 door Jeroen Strik.
'
' Sneltoets: CTRL+SHIFT+J
'
    With Selection.Font
        While IsNumeric(C1) = False Or C1 = ""
            C1 = Application.InputBox("Geef Start week")
        Wend
        While IsNumeric(C2) = False Or C2 = ""
             C2 = Application.InputBox("Geef Eind week")
        Wend
        Rij = ActiveCell.Row
        Range("A" & Rij) = C1
        Range("B" & Rij) = C2
        
        With Range("C2:IV2")
            Set CB = .Find(C1, lookat:=xlWhole)
            Set CE = .Find(C2, lookat:=xlWhole)
        End With
        If CB <> "" And CE <> "" Then
            Range("C" & Rij & ":" & "IV" & Rij).Clear
            Range(Chr(64 + CB.Column) & Rij & ":" & Chr(64 + CE.Column) & Rij).Value = 1
            Range(Chr(64 + CB.Column) & Rij & ":" & Chr(64 + CE.Column) & Rij).Interior.ColorIndex = 6
        End If
    End With
End Sub

Met vriendelijke groet,


Roncancio

 

[knoop1982]

je had helemaal gelijk bedankt voor de hulp

:thumb:

 

[knoop1982]

zit alleen nog met een vraag die andere misschien kunnen beantwoorden:

nu wordt alles netjes op de regel zelf geplaatst waar die ActiveCell staat geselecteerd alleen wil ik alles automatisch hebben.

Dus als alle Begin en Eind weken zijn ingevuld dat die dan alle 1-en gaat neerzetten achter de begin en eind weken nu moet ik steeds weer die macro aanspreken om 1 regel te vullen..

ik hoop dat iemand mij kan helpen.

mvg
jeroen