Hijskabels vervangen !

[Warme bakkertje]

Ik heb mij verkeerd uitgedrukt. In je macro verwijs je naar Blad10 om de gegevens te verwerken, maar dat is nergens te bespeuren.

 

[trucker10]

Bij deze

Private Sub userform_initialize()
    sq = Application.Transpose[COLOR="red"]([loopkranen])[/COLOR]    ComboBox1.List = sq
End Sub

en deze

Private Sub CommandButton2_Click()
    With Sheets("[COLOR="red"]Vervangingen van kabels[/COLOR]").Rows(6).Find(ComboBox1, , xlValues, xlWhole)
        If .Offset(1) = "" Then
            .Offset(1) = DateValue(TextBox1.Text)
        Else
            'Sheets("Blad10").Cells(Rows.Count, .Column).End(xlUp).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy")
            Sheets("[COLOR="red"]Vervangingen van kabels[/COLOR]").Cells(Rows.Count, .Column).End(xlUp).Offset(1) = DateValue(TextBox1.Text)
        End If
    End With
End Sub

en ook deze

Private Sub Cmd_Invullen_Click()
    UserForm[COLOR="red"]3[/COLOR].TextBox1.Value = Format(Frm_Rooster.Cal_Rooster.Value, "dd/mm/yyyy")
    Unload Me
End Sub

 

[HSV]

Danny ik heb het aangepaste bestand naar je privé-mail gestuurd.

Misschien kan je de code plaatsen Rudi, zodat wij er ook iets aan hebben.

 

[Warme bakkertje]

Harry, het zijn alles bij elkaar wel een code of 10 (3 userforms, wat bladcodes, etc...), Danny moet zijn bestand maar up to date houden en ons regelmatig van een link voorzien. Trouwens Harry, d'r zit niks bij wat jij nog niet kent hoor.

 

[trucker10]

Ik vermoed dat Danny dit wel zal doen , het up to date bestandje posten . :thumb:

 

[HSV]

De code draaide de boel onderste boven Danny.
Kleine aanpassing die volgens mij goed werkt.

 For i = 9 To 837 Step 4

Maar met zoveel hulp ben je misschien al verder. :thumb:

Rudi en Daniël, die vermoeden heb ik ook wel.

 

[danny147]

Beste allen,

Bedankt voor alles zover al teminste

Ziehier de laatste update: Hijskabels (13-1-2011).rar

Eén probleempje, bij het wegschrijven van de gegevens naar Tabblad "Gegevens" duurt dit enoooooorm lang (+/- 5 min.)

Is hier iets aan te doen ?

Groetjes Danny. :thumb:

 

[trucker10]

Beste allen,

Eén probleempje, bij het wegschrijven van de gegevens naar Tabblad "Gegevens" duurt dit enoooooorm lang (+/- 5 min.)

Is hier iets aan te doen ?

Groetjes Danny. :thumb:

Op de knop drukken en een biertje gaan drinken Wat een slimme computer heb jij .
Zit nu op de oude cpu en zonder rar uitpakker .

 

[danny147]

Beste Trucker 10,

Zie xls bestandje 1,5MB groot.

Hijskabels (13-1-2011).xls

Groetjes Danny. :thumb:

 

[Warme bakkertje]

Danny, dit is niet het bestand dat ik je laatst heb toegestuurd. Hier zitten nog allerlei fouten in die in mijn versie weggewerkt zijn. Ik heb je een nieuwe versie toegestuurd.

 

[danny147]

Beste Warme bakeertje,

Kan je eens kijken naar het bestandje nu, heb het wat aangepast en alles gekopieërd van jouw bestandje dat je door gemaild hebt ?

Bij knop wegschrijven bij 'Ingeven van gegevens" heb ik de volgende code gewijzigd omdat deze niet werkte.

Sheets("Vervangingen van kabels").Cells(Rows.Count, .Column).End(xlDown).Offset(1) = DateValue(TextBox1.Text)

Werkende code nu :

Sheets("Vervangingen van kabels").Cells(Rows.Count, .Column).End(xlUp).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy")

Bij knop Lijst wegschrijven bij "Lijst gegevens" heb ik de volgende code ook gewijzigd, zodat ik de volledige naam krijg van de afdeling ipv de ActiveSheet.Name

.Value = ActiveSheet.Name

Gewijzigd in:

.Value = ActiveSheet.Range("G2")

Bij knop Lijst wegschrijven bij "Lijst gegevens" duurt dit nog steeds enoooorm lang.


Kan men het bereik aanpassen met het gegeven in cel B3.

ReDim myArray(250, 4)

Deze aanpassen door:

ReDim myArray("B3".Value, 4)

Maar deze werkt niet.

Zie bestandje met de laatste update.

Hijskabels (14-2-2011).xls

Groetjes Danny. :thumb:

 

[trucker10]

ReDim myArray(250, 4)

Deze aanpassen door:

ReDim myArray("B3".Value, 4)

Maar deze werkt niet.

Dit werkt wel , heb geen tijdmeting gedaan

ReDim myArray(Range("B3").Value, 4)

of

ReDim myArray([B3], 4)

 

[Warme bakkertje]

Danny, het nieuwe bestand is naar je onderweg.
Jij wou de lengte v/d array laten afhangen van het aantal cellen met OK. De lengte moet echter bepaald worden door de langste lijst, daarom in G1000:G1004 het aantal elementen van elk item en in B3 het grootste getal van deze 4 . Misschien kan dit in 1 formule gegoten worden (zodat die 4 aparte formules nog verwijdert kunnen worden), maar dit laat ik aan de formulegoeroe's alhier.
Het wegschrijven hervormen liep ik al langer mee rond, maar omdat je hierover blijft doordrammen heb ik er nu werk van gemaakt. Het is nu TGV X 10 . Bij mij duurde het wegschrijven Alle loopkranen welgeteld 0.365 SEC !!!!!

 

[danny147]

Beste Warme bakkertje en Trucker 10,

Bedankt voor de oplossing, het ziet er fantastisch uit.

NU nog wat meer gegevens in plaatsen, zoals diameter van de kabels en de draadbreuken.

Je hoort nog van mij eind van de week, tot dan

Groetjes Danny. :thumb:

 

[Warme bakkertje]

Te laat gezien, maar onderstaande kan niet werken voor je 1ste 14 kolommen aangezien daar je draadbreuken onderstaan. Deze werkt bij mij zonder problemen.

.End(xlDown).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy")

 

[danny147]

Beste Warme bakkertje,

Is er hier een oplossing voor dat hij de gegevens wegschrijft vanaf rij 20 en zo naar boven toe ?

De draadbreuken moeten ook nog ingevuld worden tot aan kolom HA, hetzelfde voor de diameters van de kabels.

Of zo ik dit beter op een apart blad plaatsen ?

Groetjes danny. :thumb:

 

[Warme bakkertje]

Wat ik eigenlijk bedoelde was dat de rode regel vervangen moet worden door onderstaande en dan is je probleem toch opgelost.

.End(xlDown).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy")

Private Sub CommandButton2_Click()
    With Sheets("Vervangingen van kabels").Rows(6).Find(ComboBox1, , xlValues, xlWhole)
        If .Offset(1) = "" Then
            .Offset(1) = DateValue(TextBox1.Text)
        Else
            [COLOR="red"]Sheets("Vervangingen van kabels").Cells(Rows.Count, .Column).End(xlUp).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy")[/COLOR]        
        End If
    End With
End Sub

PS: hoe is de snelheidstest bij jou afgelopen ?

 

[danny147]

Beste Warme bakkertje,

Ik krijg een foutmelding bij de volgende code die ik aangepast hebt met uw regel er aan toe te voegen.

Private Sub CommandButton2_Click()
    With Sheets("Vervangingen van kabels").Rows(6).Find(ComboBox1, , xlValues, xlWhole)
        If .Offset(1) = "" Then
            .Offset(1) = DateValue(TextBox1.Text)
        Else
            Sheets("Vervangingen van kabels").Cells(Rows.Count, .Column).[COLOR="red"][B]End(xlDown).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy")[/B][/COLOR]        End If
    End With
End Sub

Wat de snelheidstest betreft, het max. bedraagt 0,63 sec. :thumb:

Groetjes Danny. :thumb:

 

[trucker10]

Danny tussen een With en een End With hoeft dit Sheets("Vervangingen van kabels").Cells(Rows.Count, .Column er niet te staan .
Haal dit weg laat enkel dit .End(xlDown).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy") over .

Onderstaande code met dank aan Rudi

Private Sub CommandButton2_Click()
    With Sheets("Vervangingen van kabels").Rows(6).Find(ComboBox1, , xlValues, xlWhole)
        If .Offset(1) = "" Then
            .Offset(1) = DateValue(TextBox1.Text)
        Else
            .End(xlDown).Offset(1) = Format(TextBox1.Value, "dd/mm/yyyy")
        End If
    End With
End Sub

 

[danny147]

Beste Trucker10,

Bedankt Daniël en Rudi.

Het werkt nu, hop naar de volgende stap.

Groetjes Danny. :thumb: