Help!

PC-Problemen?
De vrijwilligers van Oplossing.be zoeken gratis met u mee!

Hulp bij posten

Recente topics

Auteur Topic: Lijnen invoegen via macro (afhankelijk van waarde in cel)  (gelezen 13018 keer)

0 leden en 1 gast bekijken dit topic.

Offline Easy

  • Lid
  • *
  • Berichten: 47
  • Geslacht: Man
  • Only the sky is the limit
Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Gepost op: 04 december 2007, 19:49:40 »
Beste,

Ik zou graag via een macro lijnen willen invoegen in een excel sheet. De plaats waar de lijn ingevoegd moet worden is afhankelijk van de waarde in een cel( vergelijking tussen de waarde in de cellen welke elkaar grenzen).

Als bijlage een voorbeeld hoe de file is opgesteld voor het uitvoeren van de macro en erna.(Nu handmatig uitgevoerd)

Wie kan mij hierin de juiste weg wijzen.

Met dank.

Windows Vista Business SP2 NLD
Intel(R) Core(TM)2 Quad  CPU   Q9550  @ 2.83GHz 2833
P5Q-E
NVIDIA GeForce 9600 GT 512MB 1680 x 1050
High Definition Audio-apparaat
Nr: 1 Model: SAMSUNG HD103UJ ATA Device

Offline Erik Van Geit

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 306
  • Geslacht: Man
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #1 Gepost op: 04 december 2007, 22:42:16 »
Hallo, Easy,

Het is niet moeilijk om te doen wat je hier vraagt, maar voorwaardelijke opmaak lijkt me hier eerder aangewezen. Ik zit natuurlijk vanuit Exel zelf te denken: lege rijen tussen je data is niet zo goed om nog bewerkingen te kunnen doen (sorteren, filteren, bepaalde formules) En als je dan iets wijzigt aan je data, zit je helemaal in de knoei...

Waarom wil je dat zo doen? Waarom wil je cellen gebruiken om de data te scheiden?

In bijlage 2 manieren via voorwaardelijke opmaak.
1ste heel eenvoudig:
selecteer A2:... (tot waar je wil, aantal kolommen en rijen heeft geen belang)
A2 is actieve cel
=$A2<>$A3
gebruik als opmaak een "dikke onderrand"
2de met behulp van een extra kolom
mooier resultaat wat wellicht meer aansluit bij je behoefte om een duidelijk onderscheid te maken
   A      B     
 2 WAAR   92132
 3 WAAR   92132
 4 WAAR   92132
 5 ONWAAR 93451
 6 ONWAAR 93451
 7 WAAR   93879
 8 WAAR   93879
 9 WAAR   93879
10 WAAR   93879
11 WAAR   93879
12 WAAR   93879
13 ONWAAR 94562
14 ONWAAR 94562

Sheet2

[Table-It] version 07 by Erik Van Geit
ADRES   FORMULE (1ste cel)
A2:A14  =ALS(B2=B1;A1;NIET(A1))

[Table-It] version 07 by Erik Van Geit
RANGE   FORMULA (1st cell)
A2:A14  =IF(B2=B1,A1,NOT(A1))

[Table-It] version 07 by Erik Van Geit
selecteer A2:... (tot waar je wil, aantal kolommen en rijen heeft geen belang)
A2 is actieve cel
de formule verwijst gewoon naar kolom A (WAAR of ONWAAR)
=$A2
kies een kleur (ik hou van lichtgeel :) )
Nu krijg je afwisselend witte en gele "banden"

beste groeten,
Erik

Offline Easy

  • Lid
  • *
  • Berichten: 47
  • Geslacht: Man
  • Only the sky is the limit
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #2 Gepost op: 04 december 2007, 23:09:13 »
Goede avond Erik,

U was één van de personen waarvan ik een reactie verwachte.(+)

Excel bezien ms niet slim om lege rijen toe te voegen, maar bij mij is het een lijst uit SAP en deze omzet naar excel met een macro. Deze lijst is maandelijks als "hardcopy" te verdelen.

Dus deze actie is enkel om de layout van het rapport te bepalen.

Dus deze code zou in mijn al bestaande code geschreven moeten worden.

Ik kan moeilijk mijn hele file op het net gooien gezien de vertrouwelijke informatie.

De lijst is altijd op dezelfde manier in sap opgesteld, Via een macro kom ik al tot het resultaat als in voorbeeld.

Nu nog wat code om de lege rijen toe te voegen.

Mss toch in VBA?

Mvgr.
Windows Vista Business SP2 NLD
Intel(R) Core(TM)2 Quad  CPU   Q9550  @ 2.83GHz 2833
P5Q-E
NVIDIA GeForce 9600 GT 512MB 1680 x 1050
High Definition Audio-apparaat
Nr: 1 Model: SAMSUNG HD103UJ ATA Device

Offline Erik Van Geit

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 306
  • Geslacht: Man
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #3 Gepost op: 05 december 2007, 10:12:36 »
even op weg zetten:

zoek laatste rij
noem deze bijvoorbeeld LastRow

dan maak je een "achterwaartse "For ... Next lus"
For i = LastRow to 2 Step -1

binnen die lus, vergelijk je de cel met die er boven
If Cells(i, 1) <> ...

als aan de voorwaarde voldaan is, "insert" dan een "row" en kleur ze
(kan je opnemen met macro)

Deze code is vrij duidelijk te lezen, maar kan ietwat traag lopen, wanneer er veel rijen zijn. Er bestaat nog een andere techniek, maar dat zien we dan later.

fijne dag verder,
Erik

Offline Easy

  • Lid
  • *
  • Berichten: 47
  • Geslacht: Man
  • Only the sky is the limit
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #4 Gepost op: 05 december 2007, 13:31:08 »
Erik,

Om mij even op weg te zetten heb ik iets meer hulp nodig gezien mijn beperkte kennis in VBA.

Heb al heel wat zoekwerk verricht op net en helpfunctie maar...

Is het mogelijk mij iets verder op weg te helpen.

Mvgr.
Windows Vista Business SP2 NLD
Intel(R) Core(TM)2 Quad  CPU   Q9550  @ 2.83GHz 2833
P5Q-E
NVIDIA GeForce 9600 GT 512MB 1680 x 1050
High Definition Audio-apparaat
Nr: 1 Model: SAMSUNG HD103UJ ATA Device

Offline RedHead

  • Excel-Expert
  • Ambassadeur
  • *****
  • Berichten: 2.277
  • Geslacht: Man
  • Met Excel lukt 't wel.... (toch???)
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #5 Gepost op: 05 december 2007, 14:47:09 »
Erik was me net voor met het melden van de optie van 'voorwaardelijke opmaak'... :'( Daarom kan ik het nu toch niet laten een voorbeeldje te plaatsen van een 'lus'. Er zijn uiteraard vele wegen die naar Rome leiden, en dit is er een van... ;DSub VoegRegelTussen()
Dim i As Long

    i = 2
   
    Do
        If Cells(i, 1).Value <> Cells(i + 1, 1).Value Then
            With Cells(i + 1, 1)
                .EntireRow.Insert
                .Offset(-1).Resize(, 3).Interior.ColorIndex = 15
            End With
            Rows(i + 1).RowHeight = 5
            i = i + 1
        End If
        i = i + 1
    Loop Until IsEmpty(Cells(i, 1))

End Sub

Groet, Leo
______________________________

Groet, Leo

Offline Erik Van Geit

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 306
  • Geslacht: Man
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #6 Gepost op: 05 december 2007, 21:29:59 »
Dat is dus de code met een "loop". Persoonlijk hou ik meer van
For ... Next Step -1Maar dit type code can zeeeer lang duren...


De volgende code heb ik even getest met 20000 rijen: minder dan 1 seconde.
Option Explicit

Sub insert_rows_on_each_change()
'Erik Van Geit
'080628

'EXAMPLE
'CC = 3, FR = 2, NR = 2
'START WITH
'a1  b1  header  d1
'a2  b2  A   d2
'a3  b3  A   d3
'a4  b4  B   d4
'a5  b5  C   d5
'a6  b6  C   d6
'RESULT
'a1  b1  header  d1
'a2  b2  A   d2
'a3  b3  A   d3
'
'
'a4  b4  B   d4
'
'
'a5  b5  C   d5
'a6  b6  C   d6

Dim rng As Range
Dim LR As Long              'Last Row
Dim CC As Long
Dim FR As Long
Dim NR As Long
Dim NC As Long

'***** EDIT the following lines ****
CC = 1        'Check this Column
FR = 2        'First Row with data: MINIMUM = 2
NR = 1        'Number of Rows to insert
NC = 3        'Number of Columns to color
'***** END EDIT ****

Application.ScreenUpdating = False

LR = Cells(Rows.Count, CC).End(xlUp).Row
Columns(CC).EntireColumn.Insert

Set rng = Range(Cells(FR + 1, CC), Cells(LR, CC))

Cells(FR, CC) = 1

    With rng
    .FormulaR1C1 = "=IF(RC[1]=R[-1]C[1],R[-1]C,R[-1]C+1)"
    .Value = .Value
        With .Offset(.Rows.Count, 0)
        .Cells(1, 1).Value = 1
            With .Resize(.Cells(1, 1).Offset(-1, 0) - 1, 1)
            .DataSeries Rowcol:=xlColumns, Type:=xlLinear, step:=1
                With .Resize(, NC + 1)
                .Interior.ColorIndex = 15
                .Copy .Resize(NR * .Rows.Count, 1)
                .RowHeight = 5
                End With
            End With
        End With
    LR = Cells(Rows.Count, CC).End(xlUp).Row
    Range(Cells(FR, CC), Cells(LR, CC)).EntireRow.Sort Key1:=.Cells(1, 1)
    End With

Columns(CC).EntireColumn.Delete

Application.ScreenUpdating = True

End Sub
Als je er doorheen loopt met funcietoets F8, dan kan je op je werkblad volgen wat er gebeurt. Dit proces kan je zelfs manueel in korte tijd uitvoeren (als je wat handig bent zeker in 1 minuut)

De code laat toe, dat je instelt:
1. welke kolom er nagekeken wordt
2. welke de eerste rij is
3. hoeveel rijen er tussen komen
4. hoeveel kolommen er gekleurd moeten worden

Om compleet te zijn zou de code ook even moeten checken of er wel voldoende rijen kunnen worden ingevoegd!

goeienavond,
Erik

Offline Easy

  • Lid
  • *
  • Berichten: 47
  • Geslacht: Man
  • Only the sky is the limit
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #7 Gepost op: 06 december 2007, 20:31:13 »
Leo, Erik,

Nu heb ik twee oplossingen voor één probleem. Over luxe gesproken....

Ik heb beide oplossingen getest op mijn document en... Hoe kan het ook anders, beide werken perfect.

Er is één groot verschil. De verwerking gebeurd bij Erik zijn code in een flits en bij Leo zijn oplossing ziet men wat er gebeurd.(stap voor stap regel invoegen)

Mijn voorkeur is Erik zijn code gezien de super snelle verwerking maar dit wil niet zeggen dat ik jullie beide inspanningen niet waardeer, integendeel.

Bedankt om mijn probleempje met zoveel aandacht op te lossen en ik weet waar ik moet zijn bij een nieuw probleem.
(En nu ga ik mij wat verder verdiepen in het onleden van de code)

Mvgr.
Windows Vista Business SP2 NLD
Intel(R) Core(TM)2 Quad  CPU   Q9550  @ 2.83GHz 2833
P5Q-E
NVIDIA GeForce 9600 GT 512MB 1680 x 1050
High Definition Audio-apparaat
Nr: 1 Model: SAMSUNG HD103UJ ATA Device

Offline RedHead

  • Excel-Expert
  • Ambassadeur
  • *****
  • Berichten: 2.277
  • Geslacht: Man
  • Met Excel lukt 't wel.... (toch???)
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #8 Gepost op: 06 december 2007, 22:19:03 »
Easy, De codes van Erik zijn inderdaad meesterlijk! Daar kan je als hobby-programmeur (zoals ik ;D) absoluut niet omheen. Het mooie is wel dat je er ontzettend veel van kan leren (ook al gaat het vaak 'flink boven m'n pet')

Citaat van: Easy
bij Leo zijn oplossing ziet men wat er gebeurd.(stap voor stap regel invoegen)
De reden dat je in mijn code-lus de 'boel' ziet scrollen komt door het ontbreken van deze 2 regels: Application.Screenupdating = False en Application.Screenupdating = True. Plak de 1e regel maar 'ns direct onder 'Dim i as Long' en de 2e regel gelijk boven het 'End Sub'.
Je zal dan 2 dingen opmerken.
1) er wordt niet meer gescrolled
2) je code wordt er aanzienlijk sneller van (je beeld hoeft niet meer continu opgebouwd te worden.)

Succes met 'mee-hobbyen'... ;)

Groet, Leo
______________________________

Groet, Leo

Offline Erik Van Geit

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 306
  • Geslacht: Man
Re: Lijnen invoegen via macro (afhankelijk van waarde in cel)
« Reactie #9 Gepost op: 06 december 2007, 23:26:11 »
Hallo,

Doorliep je de code al met functietoets F8? Dan zie je hoe eenvoudig het in zijn werk gaat:
1. extra kolom met formule
2. DataSeries
3. het juiste aantal rijen kleuren (en hoogte instellen) onder de data, dus alles in 1 keer
4. sorteren, waardoor de rijen vanzelf worden ingevoegd.
5. verwijder extra kolom

Als dessert van deze dag :-* (is hier geen smiley met "hmm lekker!" ?), nog een kleine toevoeging... Dit zat me nog niet lekker.
Citaat
Om compleet te zijn zou de code ook even moeten checken of er wel voldoende rijen kunnen worden ingevoegd!
Uiteindelijk was een lijntje met somproduct genoeg om de telling van te voren uit te voeren  :)
cnt = Evaluate("=SUMPRODUCT(--(" & rng.Address & "<>" & rng.Offset(1).Address & "))")
Volledige procedure:
Option Explicit

Sub insert_rows_on_each_change()
'Erik Van Geit
'080628

'EXAMPLE
'CC = 3, FR = 2, NR = 2
'START WITH
'a1  b1  header  d1
'a2  b2  A   d2
'a3  b3  A   d3
'a4  b4  B   d4
'a5  b5  C   d5
'a6  b6  C   d6
'RESULT
'a1  b1  header  d1
'a2  b2  A   d2
'a3  b3  A   d3
'
'
'a4  b4  B   d4
'
'
'a5  b5  C   d5
'a6  b6  C   d6

Dim rng As Range
Dim LR As Long              'Last Row
Dim CC As Long
Dim FR As Long
Dim NR As Long
Dim NC As Long
Dim cnt As Long

'***** EDIT the following lines ****
CC = 1        'Check this Column
FR = 2        'First Row with data: MINIMUM = 2
NR = 1        'Number of Rows to insert
NC = 3        'Number of Columns to color
'***** END EDIT ****

Application.ScreenUpdating = False

LR = Cells(Rows.Count, CC).End(xlUp).Row

    With Range(Cells(FR, CC), Cells(LR, CC))
    Set rng = .Resize(.Rows.Count - 1)
    End With
   
    cnt = Evaluate("=SUMPRODUCT(--(" & rng.Address & "<>" & rng.Offset(1).Address & "))")
   
    If LR + cnt > Rows.Count Then
    MsgBox "Impossible to insert all rows!" & vbNewLine & vbNewLine & _
    "Current last row:" & vbTab & LR & vbNewLine & _
    "Rows to insert:" & vbTab & cnt & vbNewLine & _
    "Available rows:" & vbTab & Rows.Count, vbCritical, "ERROR"
    Exit Sub
    End If

Columns(CC).EntireColumn.Insert

Set rng = Range(Cells(FR + 1, CC), Cells(LR, CC))

Cells(FR, CC) = 1

    With rng
    .FormulaR1C1 = "=IF(RC[1]=R[-1]C[1],R[-1]C,R[-1]C+1)"
    .Value = .Value
        With .Offset(.Rows.Count, 0)
        .Cells(1, 1).Value = 1
            With .Resize(.Cells(1, 1).Offset(-1, 0) - 1, 1)
            .DataSeries Rowcol:=xlColumns, Type:=xlLinear, step:=1
                With .Resize(, NC + 1)
                .Interior.ColorIndex = 15
                .Copy .Resize(NR * .Rows.Count, 1)
                .RowHeight = 5
                End With
            End With
        End With
    LR = Cells(Rows.Count, CC).End(xlUp).Row
    Range(Cells(FR, CC), Cells(LR, CC)).EntireRow.Sort Key1:=.Cells(1, 1)
    End With

Columns(CC).EntireColumn.Delete

Application.ScreenUpdating = True

End Sub

 


www.combell.com