Formule compleet maken waarde X opzoeken

[CRUZ2]

Beste Forum leden,

Met de volgende formule probeer ik waarde X op te zoeken in de range (C66:C96).
Als hij de X heeft gevonden moet hij in de zelfde rij in kolom B deze blad kopieren en plakken aan het eind.

Wat gaat er fout?

Formule:

Sub KRACHTOPNEMERS()

Dim ws As Worksheet
Dim Ctrl As Control

B = Range("C66:C96")
        If Not Range("type1").Value = "X" Then
            Range("type1").Value = "X"
            With ActiveSheets.Range("B66:B96")
            Set p = .Range(B).Find("X")
            Worksheets(ActiveSheets.Range(B).Find("X")).Visible = True
            Worksheets(.Range("B" & p.Row).Value).Copy After:=Worksheets("Questionnaires").Range("B" & p.Row)
            Worksheets(.Range("B" & p.Row).Value).Visible = False
        MsgBox "Grijper sheet toegevoegd -Gaarne invullen- "
End With
Exit Sub
End If
MsgBox "Grijper sheet toegevoegd -Gaarne invullen- "


End Sub

Ik krijg Fout 424 object vereist

Alvast bedankt,

 

[Roncancio]

Er staat veel onnodige code in:

Sub KRACHTOPNEMERS()

[COLOR="Red"]Dim ws As Worksheet
Dim Ctrl As Control
[/COLOR]
B = Range("C66:C96")
        If Not Range("type1").Value = "X" Then
            Range("type1").Value = "X"
            With ActiveSheet[COLOR="Red"]s[/COLOR][COLOR="Red"].Range("B66:B96")[/COLOR]
            Set p = .Range(B).Find("X")
            Worksheets(ActiveSheets.Range(B).Find("X")).Visible = True
            Worksheets(.Range("B" & p.Row).Value).Copy After:=Worksheets("Questionnaires").Range("B" & p.Row)
            Worksheets(.Range("B" & p.Row).Value).Visible = False
        MsgBox "Grijper sheet toegevoegd -Gaarne invullen- "
End With
[COLOR="Red"]Exit Sub[/COLOR]
End If
[COLOR="Red"]MsgBox "Grijper sheet toegevoegd -Gaarne invullen- "[/COLOR]


End Sub

- Je definieert WS als een Worksheet en CTRL as Control maar volgens gebruik je ze niet in de code.
Dan kan je ze beter weglaten.
- De bedoeling van de If-functie is mij niet helemaal duidelijk. Zo wordt het gehele bereik voorzien van X.
- De S bij Activesheet moet weg.
- Als je With gebruik en je verwijst naar een bereik dan kan je niet 2 keer Range gebruiken.
- Exit Sub is overbodig
- Volgens mij is de 2e msgbox overbodig.
- Het is raadzaam om te controleren of P gevonden wordt.

Volgens mij zou het zo kunnen:

Sub KRACHTOPNEMERS()

B = "C66:C96"
Set p = Range(B).Find("X", , xlValues, xlWhole)
If Not p Is Nothing Then
    With Worksheets(Range("B" & p.Row).Value)
'            .Visible = True
        .Copy After:=Worksheets(Worksheets(Worksheets("Questionnaires").Range("B" & p.Row).Value).Index)
        .Visible = False
    End With
    MsgBox "Grijper sheet toegevoegd -Gaarne invullen- "
End If

End Sub

Met vriendelijke groet,


Roncancio

 

[CRUZ2]

Opgelost maar volgende uitdaging

Beste Roncanario,

Ik heb de excel opgave als volgt opgelost:

Dim b As String
Dim Ctrl As Control
On Error GoTo foutje:

If Range("A65").Value = "Slechts 1 keuze toegestaan" Then
MsgBox "Teveel grijpers geselecteerd"
Range("C66,c72,C78,C84,C90,C96").Value = ""
Exit Sub
Else

With Sheets("Questionnaire").Range("C66:C96")
            Set c = .Find("X", LookIn:=xlValues).Offset(0, -1)
            If Not Range("type1").Value = "X" Then
            Range("type1").Value = "X"
            b = c.Value
            Worksheets(b).Visible = True
            Worksheets(b).Copy After:=Worksheets(b)
            Worksheets(b).Visible = False
        MsgBox "Grijper sheet toegevoegd -Gaarne invullen- "
Else
MsgBox "Grijper sheet reeds aanwezig"
Exit Sub

End If
End With
Exit Sub
End If

foutje:
MsgBox "Geen keuze gemaakt"
Exit Sub

Nu heb ik een volgende uitdaging
Met de zelfde code wil ik het volgende uitvoeren:
"Uit de range (die nu D6468 wordt) moet de macro de waarde uit bijvoorbeeld D64 nemen (bijv. waarde 1) en de sheet die twee cellen ernaast (offset is 0,2) pakken en deze kopieren in de zelfde worksheet"

Ik gebruik hiervoor nu als stand alone knop de volgende formule:

Private Sub CommandButton3_Click()
Dim G  As Integer
Dim H As String

If Range("Draadklem").Value >= [d66] Then
MsgBox "Loadcell sheet reeds aanwezig"
Exit Sub
Else
G = [d66] - [Draadklem]
Range("Draadklem").Value = [d66]
H = [B66]
If G > 0 Then
    For numtimes = 1 To G
    Worksheets(H).Visible = True
    Worksheets(H).Copy After:=Worksheets(H)
    Worksheets(H).Visible = False
    Next
    MsgBox "Loadcell sheet toegevoegd -Gaarne invullen- "
    End If
    LOADCELL.Hide
    End If
End Sub

Kan je me helpen deze formule om te bouwen naar een formule die dit telkens uitvoert voor de cellen die in de range D6468 staan.

Kleine samenvatting:

Als D64 is 8 dan kopier worksheet(range("D64").value.offset(0,2) 8 aan het einde.
Next D65


Alvast bedankt

 

[Roncancio]

Beste Roncanario,

Hé, die naamsverbastering kende ik nog niet!

Je zou gebruik kunnen maken van een For en Next lus
Dim rBereik as Range
For each rBereik in Range("D64: D68")
'Je Code
Next

In plaats van [d66] kan je dus Range(rBereik) gebruiken.
Ik zou niet zo scheutig zijn met Exit Sub.
Dit is in de regel geen fraaie manier van coderen en vaak onnodig.

Met vriendelijke groet,


Roncancio