[VB + Excel] Invoegen regel met data

[troyk]

Beste heren,

Ik heb het volgende:
Ik wil graag op werkblad8 de volgende macro (code) invoegen.

Sub voeg_in()

Dim i As Integer
i = 2
While Cells(i, 1) <> ""
If Cells(i - 1, 1) <> Cells(i, 1) Then
Rows(i).Select
Selection.Insert Shift:=xlDown
i = i + 1
End If
i = i + 1
Wend

End Sub

Maar ik krijg de volgende error melding:
Fout 1004 tijdens uitvoering
Door de toepassing of door het object gedefinieerde fout.

Ik word zelf niet echt veel wijzer van de Help en Google bood geen uitkomst
gezocht op: "fout 1004" , "Door de toepassing of door het object gedefinieerde fout."
e.d

[Markieman]

Ik heb je cody "ge-copy-pasted", kolom A ingevuld met wat waarden en de sub uitgevoerd.
Hij gaf geen fout, sterker nog, hij deed het.

Dus helaas kan ik je niet helpen, maar ik dacht ik meldt het even.
(Config: WinNT4SP6, Excel97)

Ik vermoed dan ook dat je fout ergens anders veroorzaakt word.

[Verwijderd]

Excel 2002 (XP) geeft ook geen enkel probleem, code is gewoon in orde.
- Werk je met een hele oude versie van Excel?
- stap eens door je code heen onder de debugger?
- geef eens wat meer info anders, bv welk regelnr treedt de fout op?

[troyk]

Ik probeerde het in eerste instantie onder Office 97 Excel, hier trad de foutmelding op.

Nu op een andere interne machine geprobeerd (2k + office2k) , werkt idd prima.
Mijn dank is groot , zo ook mijn domheid dat ik dit niet eerder geprobeerd heb.

[troyk]

Even iets nieuws,
Ik ga nu zoeken naar de negative waarde in kolom 12 (L).
Op het moment dat ik de negatieve waarde vind, wil ik graag dat hij de hele rij selecteert , een rij invoegt en kopieert.

Ik kwam tot het volgende:

code:

Sub voeg_in()

Dim i As Integer
i = 2
While Cells(i, 12) <> ""
If Cells(i - 1, 12) <= 0 Then
Rows(i).Select
Selection.Copy
Selection.Insert Shift:=xlDown
ActiveSheet.Paste
i = i + 1
End If
i = i + 1
Wend

End Sub

Maar helaas, werkt het niet naar behoren.
Het vreemde is , is dat sommige rijen wel worden gekopieerd en krijg ik netjes 2 dezelfde regels met in de 12e kolom negatieve getallen.
Maar andere regels doen het gewoon niet, de macro is niet consequent.

Help?

[Markieman]

Ik weet niet of het de bedoeling is, maar zoals je het nu hebt "verdubbel" je iedere regel na de regel met negatieve waarden. Daardoor worden negatieven waarden alleen verdubbelt als ze direct onder een andere regel met een negatieve waarde staan...

(zo inconsequent is het dus niet )

[ Voor 10% gewijzigd door Markieman op 25-05-2004 17:01 ]

[troyk]

Owh ok dat is dus niet goed,
Ik wil juist dat als hij de loop doorloopt en een negatieve waarde ziet , moet hij juist die regel verdubbelen. Enig idee?

[Markieman]

Dat hoeft toch niet moeilijk te zijn

_{disclaimer: uit de losse pols, dus niet getest}

code:

Sub voeg_in()

Dim i As Integer
i = 1

While Cells(i, 12) <> ""
   If Cells(i, 12) <= 0 Then
      Rows(i).Select
      Selection.Copy
      Selection.Insert Shift:=xlDown
      ActiveSheet.Paste
      i = i + 1
   End If
   i = i + 1
Wend

End Sub

[ Voor 5% gewijzigd door Markieman op 25-05-2004 17:10 . Reden: typo ]

[troyk]

-edit- werkt toch niet helemaal, sterker nog: Werkt niet.

Iemand?

[ Voor 82% gewijzigd door troyk op 26-05-2004 08:48 ]

[troyk]

Ik heb nu het volgende: De code van MarkieMark werkt op zich correct, het enige vreemde eraan is het volgende:

- Hij selecteert de regel met de negatieve waarde in kolom 12
- Hij copiëert de regel met de negatieve waarde in kolom 12
- hij plakt de regel met de " "
- hij verwijdert de regel met de " " weer.

Je ziet duidelijk dat alle regels netjes worden gekopiëert , maar daarna ook weer verwijdert. Waarom? Ik spit rustig verder.

-edit- ik zou bijna denken dat hij de regel selecteert, knipt en dan weer plakt , in plaats van te kopiëren.

[ Voor 14% gewijzigd door troyk op 26-05-2004 09:54 ]

[Markieman]

Hmm, hebbie hem goed copy-pasted?

Bij mij werkt tie goed, tenminste als je het volgende wilt bereiken:

code:

1
-2
3
-4
5
-6

wordt:

code:

1
-2
-2
3
-4
-4
5
-6
-6

offtopic:
Het is Markieman en niet MarkieMark

edit:

-edit- ik zou bijna denken dat hij de regel selecteert, knipt en dan weer plakt , in plaats van te kopiëren.

Heb je mijn code goed overgetypt. Als ik dit lees lijkt het alsof je Selection.Cut gebruik ipv Selection.Copy in regel 9

[ Voor 47% gewijzigd door Markieman op 26-05-2004 09:57 ]

[troyk]

Ik zie dat het bij jou wel goed werkt, vreemd. Ik heb je code (goed) gecopy-paste,
uitgevoerd op het juiste blad, juiste kolom. Het is ook erg duidelijk dat de routine goed wordt uigevoerd , want ik kan duidelijk zien dat hij de regel selecteert en kopiëert. Maar het lijkt wel alsof hij daarna de regel weer verwijdert.

Ik krijg het volgende (alleen even de negatieve waarden)

code:

-201,7 
-146,0 
-135,8 
-135,0 
-128,5 
-125,0 
-100,8 
-91,7 
-91,7 
-91,7 
-65,0 
-63,3 
-63,3 
-25,0 
-11,2 
-10,0 
-5,0 
-2,5

Je ziet dat sommige waarden wel gekopiëert zijn en andere weer niet.

-edit- Ik zie inderdaad dat de code juist werkt als ik een nieuw blad aanmaak.
Blijkbaar zit het probleem zich niet in de code, maar misschien in de opmaak van mijn blad?

[ Voor 15% gewijzigd door troyk op 26-05-2004 10:02 ]

[Markieman]

Zeker vreemd, ik heb het nogmaals getest maar code werkt ok.
Zeker weten dat je goed gecopieerd hebt?

Heb je anders iets onder een event (zoals Worksheet_Change) wat in de weg zit?

Anders zou ik het echt niet weten...

[troyk]

Hmm ok,

En als ik nu eerst een lege regel invoeg,
daarna een nieuwe loop maak en dan pas de regel (met negatief getal) in die lege regel daaronder of daarboven kopëer?

Verder heb ik geen code in mijn blad staan.

- edit - Ook aan het werk?

[ Voor 8% gewijzigd door troyk op 26-05-2004 10:10 ]

[Markieman]

troyk schreef op 26 mei 2004 @ 10:09:
En als ik nu eerst een lege regel invoeg,
daarna een nieuwe loop maak en dan pas de regel (met negatief getal) in die lege regel daaronder of daarboven kopëer?

Lijkt me wat overdreven.

Je zegt zelf dat het in een nieuw blad wel werkt. Dus er zit toch ergens een fout.

Loop anders eens met F8 stap voor stap door de sub voeg_in heen, en kijk na iedere regel wat er in het blad gebeurt. Ofwel, ff debuggen...

[troyk]

Goed plan,
ik houd je op de hoogte.

[troyk]

Ok het probleem was dat een andere gebruiker (met rechten) een formule aan de cell die ik kopiëerde had gekoppeld, waardoor mijn gekopiëerde regel.values niet echt voldeden aan de source-regel.

Nu heb ik de cellen maar als waarden naar een nieuw blad gekopiëerd. Vanuit hier voer ik de code uit en dat werkt uiteraard wel. Hoewel dit niet echt handig is, is het een oplossing.

Nu moet ik alleen nog een value in de 3e kolom veranderen bij elke nieuw gemaakte regel. Druk druk druk,

Mijn dank is groot.

[troyk]

Ok , ga ik weer verder:
Ik heb nu het volgende:

code:

Dim lastrow As Long
Dim row_index As Long

lastrow = ActiveSheet.Cells(Rows.Count, "m").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
    If LCase(Cells(row_index + 1, "m").Value) = "3" Then
        Cells(row_index + 1, "m").Resize(3, 1).EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "2" Then
        Cells(row_index + 1, "m").Resize(2, 1).EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "1" Then
        Cells(row_index + 1, "m").EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "4" Then
        Cells(row_index + 1, "m").Resize(4, 1).EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "5" Then
        Cells(row_index + 1, "m").Resize(5, 1).EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "6" Then
        Cells(row_index + 1, "m").Resize(6, 1).EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "7" Then
        Cells(row_index + 1, "m").Resize(7, 1).EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "8" Then
        Cells(row_index + 1, "m").Resize(8, 1).EntireRow.Insert _
        (xlShiftUp)
    ElseIf LCase(Cells(row_index + 1, "m").Value) = "9" Then
        Cells(row_index + 1, "m").Resize(9, 1).EntireRow.Insert _
        (xlShiftUp)
    End If
Next
End Sub

De code werkt prima, ik wil eigenlijk alleen dat de rows die hij insert ook kopiëert.
Dus waar value = 8 , voeg 8 dezelfde rijen in (kopiën van de regel waar value = 8 )
Ben zelf nu al een tijdje druk, maar ik dacht misschien heeft iemand hier een simpele oplossing.

[troyk]

code:

lastrow = ActiveSheet.Cells(Rows.Count, "m").End(xlUp).Row
For row_index = lastrow - 1 To 1 Step -1
    If LCase(Cells(row_index + 1, "m").Value) = "3" Then
        Cells(row_index + 1, "m").Select
        Cells(row_index + 1, "m").Resize(3, 1).EntireRow.Insert _
        (xlShiftUp) And Selection.Copy

Met deze code , kopiëer ik alleen maar 3'en in elk veld , dus dit werkt niet.
Maar als ik de range aangeef: Cells(row_index + 1).Select gebeurt er ook nix. Zie ik iets over het hoofd?

[troyk]

Ik heb zelfs het volgende geprobeert:

RngAK = Array("a","b","c",...."k")

Cells(row_index +1 , RngAK) <-- ook niet

[Markieman]

Wat is het eigenlijk wat je wilt?
^{ikke niet helemaal snappe}

[troyk]

ok, ik wil graag het volgende:

In kolom m staat af en toe een waarde variërend van 1 tot 10 .
Op het moment dat er 1 staat , voegt de functie 1 lege regel boven de regel waar 1 staat in.

Op het moment dat er 2 staat , voegt de functie 2 lege regels boven de regel waar 2 staat in.

Op het moment dat er 3 staat , voegt de functie 3 lege regel boven de regel waar 3 staat in.

etc.

Dit werkt prima.
Maar ik wil: I.p.v de lege regel ---> Een of meerdere (hangt van de waarde af(1,2,3....)) kopiën van de regel waar de waarde (1..2..3...) is.

Dus
De loop checked:
Henk Gerritsen nr900 Straat12 3
Hij ziet de 3 , gaat nu 3 keer de regel kopïeren
Henk Gerritsen nr900 Straat12 3
Henk Gerritsen nr900 Straat12 3
Henk Gerritsen nr900 Straat12 3
Henk Gerritsen nr900 Straat12 3

de 1e regel moet het origineel zijn.
Ik wil dit omdat ik straks bijvoorbeeld Straat12 oplopend wil hebben , dus na invoegen + kopie:
Henk Gerritsen nr900 Straat12 3
Henk Gerritsen nr900 Straat13 3
Henk Gerritsen nr900 Straat14 3
Henk Gerritsen nr900 Straat15 3

[Markieman]

code:

Sub voeg_in()

Dim I As Integer
Dim J As Integer
Dim lAantal As Long

I = 1

Do While Not IsEmpty(Cells(I, 13))
    lAantal = Cells(I, 13)
    
    If lAantal > 0 Then
        For J = 1 To lAantal
            Rows(I + J).Insert shift:=xlDown
        Next J
        
        Rows(I).Copy
        For J = 1 To lAantal
            Rows(I + J).Select
            ActiveSheet.Paste
        Next J

        I = I + lAantal
    End If
    I = I + 1
Loop

End Sub

[troyk]

Markieman , wat is je adres?
Dan stuurt de zaak je een drankbon

Ons planprogramma is bijna af , de meeste functies zaten al in excel ingebakken dus zijn we al een heel eind gekomen.
Het vreemde was dat er geen functie regel invoegen was,vandaar dat ik het in VBA wilde doen.

[ Voor 48% gewijzigd door troyk op 27-05-2004 16:54 ]

[Markieman]

troyk schreef op 27 mei 2004 @ 16:50:
Markieman , wat is je adres?
Dan stuurt de zaak je een drankbon

troyk, wat is je mailadres? ik zet mijn adres niet graag online.
of mail mij, adres staat in mijn profiel.

[troyk]

-Done-

[troyk]

Erm

Ik kom toch nog even terug op mijn scriptje

Dit hieronder werkt uiteraard perfect!
Ik voeg het aantal regels toe aan de hand van kolom 32 En kopiëer ze daarna

Maar wat ik eigenlijk wil , is dat de gekopiëerde regels bij een bepaalde kolom + 1 gaan krijgen. Kan ik daar het beste een aparte sub voor maken? Of is dat makkelijk in te bouwen in het eerste stukje code.

Ik heb zelf het een en ander geprobeerd en kwam tot het 2e stukje code:

code:

Sub voeg_in()

Dim i As Integer
Dim J As Integer
Dim lAantal As Long

i = 2

Do While Not IsEmpty(Cells(i, 32))
    lAantal = Cells(i, 32)
    
    If lAantal > 0 Then
        For J = 1 To lAantal
            Rows(i + J).Insert Shift:=xlDown
        

   
        Next J
        
        Rows(i).Copy
        For J = 1 To lAantal
            Rows(i + J).Select
            
            ActiveSheet.Paste
        Next J

        i = i + lAantal
    End If
    i = i + 1
Loop

End Sub

code:

Sub plus_waarde()
Dim r As Integer

r = 1

    While Cells(r, 2) = Cells(r + 1, 2)

      Cells(r + 1, 2).Value = Cells(r + 1, 2).Value + 1
   
      r = r + 1
   
    Wend
   
End Sub

De bedoeling is dus (indien er 5 regels worden toegevoegd):

code:

11
12
13
14
15

[troyk]

Ok hier heb ik het geprobeerd met een Count instructie:

code:

Sub RemoveDuplicates()

   
   totalrows = ActiveSheet.UsedRange.Rows.Count
   Count = 1
   For Row = totalrows To 1 Step -1
      If Cells(Row, 1).Value = Cells(Row - 1, 1).Value Then
           Cells(Row, 1).Value = Cells(Row, 1).Value + 1
           Count = Count + 1
      End If
   Next Row

End Sub

Werkt ook niet, helaas.

[Markieman]

hey, ik weet niet zeker of ik begrijp wat je bedoelt maar ik denk het volgende:

Visual Basic:

Private Sub plus_waarde()

Dim I As Long

I = 1

Do While Not IsEmpty(Cells(I, 1))
    If I > 1 Then
        If Cells(I, 1) = Cells(I - 1, 1) Then
            Cells(I, 2) = Cells(I - 1, 2) + 1
        Else
            Cells(I, 2) = 1
        End If
    Else
        Cells(I, 2) = 1
    End If
    I = I + 1
Loop

End Sub

[troyk]

Hey Mark,

jij weer?

Het werkt bijna: Je verwacht nu dat als de waarde in kolom 1 gelijk is , dan moet er worden opgeteld.
Dit is niet helemaal waar,
ik wil juist dat alle waarden in kolom a (indien gelijk) met 1 worden opgeteld.
Voor:

code:

Kolom 1
10
10
10
10
10
40
40
40
40
40
40
40
40

na:

code:

Kolom 1
10
11
12
13
14
15
41
42
43
44
45
..

Maar ik pruts zelf ook nog wat verder , alvast bedankt.

p.s: Je drankbon wordt na werktijd gefrankeerd en verstuurd

[ Voor 3% gewijzigd door troyk op 02-06-2004 16:44 ]

[Markieman]

code:

Private Sub plus_waarde()

Dim I As Long
Dim lLast As Long

lLast = Cells(1, 1)
I = 2

Do While Not IsEmpty(Cells(I, 1))
    If Cells(I, 1) = lLast Then
        Cells(I, 1) = Cells(I - 1, 1) + 1
    Else
        lLast = Cells(I, 1)
    End If
    I = I + 1
Loop

End Sub