Formule aangepast (Dubbele declaratie)

Vangans · 23 mrt 2007

Beste Mensen,

Ik wil 2 formules in 1 macro plaatsen.
Nu gaf hij de foutmelding : Dubbele declaratie die ik reeds heb opgelost (denk ik).

Maar nu wil hij mijn laatste waarde -40, niet toepassen.

Kan iemand eens kijken waar mijn probleem zit?

Code:

Code:

Sub Deur_alles_in_1_keer()
 Dim c As Range, i As Long, form As String, naam As String, brho As String
    For Each c In Selection
        form = c.Offset(-3).Formula
        If form <> "" Then
            i = 1
        
            Do While IsNumeric(Mid(form, Len(form) - 1 - i, 1))
                i = i + 1
            Loop
           If InStr(form, "hoogte") > 0 Then
                brho = "Vollehoogte"
            naam = Mid(form, Len(form) - i - Len(brho), Len(brho) + i)
            c.Formula = Replace(form, naam, "(" & naam & "-83/2)")
            ElseIf InStr(form, "breedte") > 0 Then
                brho = "Vollebreedte"
                naam = Mid(form, Len(form) - i - Len(brho), Len(brho) + i)
            c.Formula = Replace(form, naam, "(" & naam & "-83)")
            End If
            
        End If
        
    Next c

 
Selection.Copy

Selection.Offset(2).Select

Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats

Application.CutCopyMode = False

 Dim b As Range, o As Long, form2 As String, naam2 As String, brho2 As String
           If form2 <> "" Then
            o = 1
        
          Do While IsNumeric(Mid(form2, Len(form2) - 1 - o, 1))
                o = o + 1
            Loop
           
            If InStr(form2, "hoogte") > 0 Then
               brho2 = "vleugelhoogte"
              naam2 = Mid(form2, Len(form2) - o - Len(brho2), Len(brho2) + o)
               b.Formula = Replace(form2, naam2, "(" & naam2 & ")")
            ElseIf InStr(form2, "breedte") > 0 Then
                brho2 = "Vleugelbreedte"
                naam2 = Mid(form2, Len(form2) - o - Len(brho2), Len(brho2) + o)
                b.Formula = Replace(form2, naam2, "(" & naam2 & "-40)")
           End If
        End If
  
End Sub

Mvg

Vangans · 23 mrt 2007

Ik veronderstel dat deze regel het grote deel van mijn probleem is?

Code:

Dim b As Range, o As Long, form2 As String, naam2 As String, brho2 As String

Want deze regel zou hij moeten toepassen

Code:

 b.Formula = Replace(form2, naam2, "(" & naam2 & "-40)")

Demeter · 23 mrt 2007

Als ik het goed zie vul je nergens b met data.
Hoe kan je hier dan een formule aan hangen welke je ook nog eens gaat vervangen vervangen?

Vangans · 23 mrt 2007

Dan mis ik nog een offset in het begin?

Demeter · 23 mrt 2007

Ik weet niet wat b zou moeten zijn.
Maar in ieder geval moet deze nog wel gevuld worden

Vangans · 23 mrt 2007

Daar hangt toch dezelfde waarde aan als bij c, en daar werkt het wel ?

Demeter · 23 mrt 2007

Code:

    For Each c In Selection
        form = c.Offset(-3).Formula

kan ik voor b niet terug vinden in je code.

Misschien moet je deze lop er nog omheen zetten.

Vangans · 23 mrt 2007

Ferenc, klopt idd, maar hij doet nog steeds niks in mijn velden als ik er dit van maak

Code:

 Dim b As Range, o As Long, form2 As String, naam2 As String, brho2 As String
  For Each b In Selection
        form2 = b.Offset(-5).Formula ...

Jammer genoeg ...

Demeter · 23 mrt 2007

Wordt de code geheel doorlepen zonder foutmelding?
Heb je al geprobeert te kijken wat er op iedere regel gebeurt?

Klik in de verticale grijze balk direct naast je code scherm.
Hierop kun je per regel aangeven waar de code moet stoppen zodat jij kan bekijken of je variabelen wel gevuld worden en de juiste gegevens worden door gezet. Met de F8 knop ga regel voor regel door de code heen (mits deze is aangevinkt in je grijze balk).

Misschien loopt hij hierdoor ook al niet lekker:
"vleugelhoogte" is volgens mij "Vleugelhoogte"

Vangans · 23 mrt 2007

Neen daar ligt het ook niet aan Ferenc, het is allemaal in kleine letters en er staan geen spaties achter zoals vorige keer.

Het eerste deel voert hij uit, het 2de deel niet. Er komt nog een 3de deel achter en dit doet hij wel.

Dus hij doet niks van het 2de deel van de formule

Ik snap er mij niet aan waar de fout zit

code volledig :

Code:

Sub Deur_alles_in_1_keer()
 Dim c As Range, i As Long, form As String, naam As String, brho As String
    For Each c In Selection
        form = c.Offset(-3).Formula
        If form <> "" Then
            i = 1
        
            Do While IsNumeric(Mid(form, Len(form) - 1 - i, 1))
                i = i + 1
            Loop
           If InStr(form, "hoogte") > 0 Then
                brho = "Vollehoogte"
            naam = Mid(form, Len(form) - i - Len(brho), Len(brho) + i)
            c.Formula = Replace(form, naam, "(" & naam & "-83/2)")
            ElseIf InStr(form, "breedte") > 0 Then
                brho = "Vollebreedte"
                naam = Mid(form, Len(form) - i - Len(brho), Len(brho) + i)
            c.Formula = Replace(form, naam, "(" & naam & "-83)")
            End If
            
        End If
        
    Next c

 Dim b As Range, o As Long, form2 As String, naam2 As String, brho2 As String
  For Each b In Selection
        form2 = b.Offset(-5).Formula
         
           If form2 <> "" Then
            o = 1
        
          Do While IsNumeric(Mid(form2, Len(form2) - 1 - o, 1))
                o = o + 1
            Loop
           
            If InStr(form2, "hoogte") > 0 Then
               brho2 = "vleugelhoogte"
              naam2 = Mid(form2, Len(form2) - o - Len(brho2), Len(brho2) + o)
               b.Formula = Replace(form2, naam2, "(" & naam2 & ")")
            ElseIf InStr(form2, "breedte") > 0 Then
                brho2 = "vleugelbreedte"
                naam2 = Mid(form2, Len(form2) - o - Len(brho2), Len(brho2) + o)
                b.Formula = Replace(form2, naam2, "(" & naam2 & "-40)")
           End If
        End If
  Next b



Selection.Copy

Selection.Offset(3).Select

Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats

Application.CutCopyMode = False
UserForm3.Show

End Sub

Demeter · 23 mrt 2007

En je hebt je gegevens ook gedebugged?
Bestand is te groot om hier te posten? Zonder prive gegevens!! (anders mijn prive email)

ps.
ook nog mijn aanpassing gelezen:

Misschien loopt hij hierdoor ook al niet lekker:
"vleugelhoogte" is volgens mij "Vleugelhoogte"

Demeter · 23 mrt 2007

Welke regels selecteer je eigenlijk? Als je een bereik van regel 1tm 5 hebt dan gebeurt er weinig natuurlijk. 5 - 5 is regel 0

Vangans · 23 mrt 2007

Ja Ferenc die hoofdletters doet hij niks mee.

Ik selecteer 1R x 5K

(p.s: het is het 2de tabblad van het bestand van vorige keer)

Demeter · 23 mrt 2007

Heb je file thuis in mijn outlook staan

.

Je code zoekt naar een formule welke in een cel 5 regels boven jouw selectie ligt.
Is deze selectie in een van de 5 bovenste rijen zul je dus niks vinden vanaf regel 6 kan er pas wat staan, 5 regels boven je selectie.

Vangans · 23 mrt 2007

Dan spreken we over het 2de deel vand e formule he?

foto brengt een beter zicht ...

De eerste formule past hij toe op 3 cellen erboven en komt in de rode omcirkelde cellen terrecht.

Het 2de deel van de formule moet hij dan berekenen op de cellen met de rode cirkel en moeten op de paarse stippen komen.

Nu staat er bij mijn offset -5. Als ik daar -2 zet (juiste) of 2. De cellen blijven leeg wanneer ik mijn macro activeer.

Vangans · 23 mrt 2007

ferenc, formule aangepast en de waarde verschijnt al in de cellen. Maar de linkse maat laat hij staan ipv er -40 op toe te passen

stuk angepaste code (bovenste deel)

Code:

Selection.Copy

Selection.Offset(2).Select

Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats

Application.CutCopyMode = False

 Dim b As Range, o As Long, form2 As String, naam2 As String, brho2 As String
 ' For Each b In Selection
        'form2 = b.Offset(-2).Formula
         
           If form2 <> "" Then
            o = 1

Vangans · 23 mrt 2007

b.Formula = b.Formula & "-40"

Dit doet hij natuurlijk wel, maar dit mag hij niet op mijn linkse cel doen.

Weet jij het Ferenc? of iemand anders

Demeter · 23 mrt 2007

Gekke is dat hij het bij c wel doet.
Kom niet echt meer uit je offset verwijzingen, zou je mij nogmaals het bestand op willen sturen: f.methorst@vsti.nl.

Vangans · 23 mrt 2007

Idd

Er is post

Als je er niet aan uitgeraakt, kan je terug beginnen met de formule uit de eerste post.

Er staat veel gras in zoals je zal zien

Vangans · 23 mrt 2007

Ferenc heeft me de juiste oplossing gegeven, waarvoor hartelijk dank ! :thumb:

Bij deze de oplossing voor mensen die nog in deze topic zouden terrecht komen.

Code:

Sub Deur_alles_in_1_keer()
Dim c As Range, i As Long, form As String, naam As String, brho As String
Dim b As Range, o As Long, form2 As String, naam2 As String, ho As String

    For Each c In Selection
    
        form = c.Offset(-3).Formula
        
        If form <> "" Then
            i = 1
        
            Do While IsNumeric(Mid(form, Len(form) - 1 - i, 1))
                i = i + 1
            Loop
            
           If InStr(form, "hoogte") > 0 Then
                brho = "Vollehoogte"
                naam = Mid(form, Len(form) - i - Len(brho), Len(brho) + i)
                c.Formula = Replace(form, naam, "(" & naam & "-83/2)")
            ElseIf InStr(form, "breedte") > 0 Then
                brho = "Vollebreedte"
                naam = Mid(form, Len(form) - i - Len(brho), Len(brho) + i)
            c.Formula = Replace(form, naam, "(" & naam & "-83)")
            End If
        End If
    Next c
    
Selection.Copy
Selection.Offset(2).Select
Selection.PasteSpecial Paste:=xlPasteFormulasAndNumberFormats
Application.CutCopyMode = False

    For Each b In Selection
        
        form2 = b.Offset(-2).Formula
        
        If form2 <> "" Then
            o = 1
        
            Do While IsNumeric(Mid(form2, Len(form2) - 1 - o, 1))
                o = o + 1
            Loop
           
            If InStr(form2, "breedte") > 0 Then
                ho = "dichtingbreedte"
                naam2 = Mid(form2, Len(form2) - o - Len(ho), Len(ho) + o)
                b.Formula = Replace(form2, naam2, "(" & naam2 & "-40)")
            ElseIf InStr(form2, "breedte") > 0 Then
                brho2 = "dichtingbreedte"
                naam2 = Mid(form2, Len(form2) - o - Len(brho2), Len(brho2) + o)
                b.Formula = Replace(form2, naam2, "(" & naam2 & "-40)")
            End If
        End If
    Next b

End Sub

Mvg

Schol ferenc

Formule aangepast (Dubbele declaratie)

Gebruiker

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Verenigingslid

Verenigingslid

Gebruiker

Verenigingslid

Gebruiker

Gebruiker

Gebruiker

Verenigingslid

Gebruiker

Gebruiker

Wij waarderen jouw privacy