Cellen selecten, samenvoegen

Status
Niet open voor verdere reacties.
M

masala09

Gebruiker
Lid geworden
6 aug 2012
Berichten
886
Beste allemaal,

Ik ben weer een beetje bezig met het opmaken van een standaard werkblad. Het werkblad bevat meerdere randen en samengevoegde cellen. Dit werkblad kan ik dan middels een knop direct nieuw aanmaken. Copy voldeed moet niet en dus moest ik uitwijken naar een andere mogelijkheid. Een mogelijkheid wat op zicht is gelukt. Echter plaats ik toch vraagtekens over 2 code regels. In beide selecteer ik.

De bedoeling is dat er van de eerste rij 10 x 10 kolommen worden samengevoegd en dit naast elkaar.
Range A1:A10, Range A11:A20, Range A21:A30 enz.

Code: 
    Dim KolStart, Nummer As Integer
  
    KolStart = 1
    Nummer = 0
    
    Sheets.Add After:=Sheets(Sheets.Count)
    
    Cells.ColumnWidth = 1
    
    Do While Nummer <= 9

        [COLOR="#FF8C00"]Cells(1, KolStart).Select
        Range(Cells(1, KolStart), ActiveCell.Offset(0, 9)).Select[/COLOR]
        
        With Selection
            .Merge
            .HorizontalAlignment = xlCenter
            .Borders(xlEdgeLeft).LineStyle = xlContinuous
            .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeBottom).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous
            .Value = Nummer
        End With
    
        KolStart = KolStart + 10
        Nummer = Nummer + 1
    
    Loop

Je ziet dat ik feitelijk 2 keer selecteer. Klopt dit. Mij staat namelijk bij dat dit niet nodig is.

Ik hoor graag van jullie.

Alvast bedankt
 
Laatst bewerkt:
Plaats je document als voorbeeld.
En deze vergelijking is uiteraard volledig overbodig:
If Nummer = 0 And Nummer < 9

Als Nummer 0 is dan is hij sowieso kleiner dan 9.
Daarnaast kan hij nooit 0 EN iets anders zijn.
 
Hoi Edmoor.

Lang geleden. Jouw opmerking over het overbodig zijn van die If dat klopt inderdaad en is al verwijderd. Het was eigenlijk een onnodige test inzake het zetten van randen. Ik wilde niet telkens een cel volledig opnieuw omlijnen als deze als gedeeltelijk is omlijnd.
Daar van de eerste kolom met nummer 0, de linkerzijde reeds een rand bezit, zo ook voor de laatste kolom met nummer 9, wilde ik voor deze de rand niet zetten. Een beetje tijdwinst proberen te halen. Echter bij het opnemen van de tijd, hoelang de code er over doet, sloeg het nergens op.

Terugkomend op mijn vraagstelling. Het gaat mij niet om de werking. De werking voldoet. Het gaat mij om het 2 keer achter elkaar selecteren. Eerst selecteer ik een cel om vanaf daar een nieuwe range te selecteren. Hier slechts mijn vraag op.

Open een werkblad. Stop de code in een module en test hem uit. De rest van de code is namelijk bijna hetzelfde. Er staat verder nog niets bijzonders in.
 
masala09 zei:
Hoi Edmoor.

Lang geleden. Jouw opmerking over het overbodig zijn van die If dat klopt inderdaad en is al verwijderd. Het was eigenlijk een onnodige test inzake het zetten van randen. Ik wilde niet telkens een cel volledig opnieuw omlijnen als deze als gedeeltelijk is omlijnd.
Daar van de eerste kolom met nummer 0, de linkerzijde reeds een rand bezit, zo ook voor de laatste kolom met nummer 9, wilde ik voor deze de rand niet zetten. Een beetje tijdwinst proberen te halen. Echter bij het opnemen van de tijd, hoelang de code er over doet, sloeg het nergens op.

Terugkomend op mijn vraagstelling. Het gaat mij niet om de werking. De werking voldoet. Het gaat mij om het 2 keer achter elkaar selecteren. Eerst selecteer ik een cel om vanaf daar een nieuwe range te selecteren. Hier slechts mijn vraag op.

Open een werkblad. Stop de code in een module en test hem uit. De rest van de code is namelijk bijna hetzelfde. Er staat verder nog niets bijzonders in.
Klik om te vergroten...

Edit: Heb de rest van de code er nog bij geplaatst. Zag dat ik een klein deel was vergeten.
 
Bv.
Code: 
Sub hsv()
Dim i As Long
For i = 1 To 100 Step 10
  With Cells(i, 1).Resize(10, 10)
   .Merge
   .Borders.LineStyle = xlContinuous
  End With
 Next i
End Sub
 
Beste HSV. Bedankt voor jouw inbreng. Echter heb ik jouw code moeten aanpassen. De With klopte in zoverre niet daar deze deze de rijen pakte i.p.v. de kolommen. Met onderstaande aanpassing werkt deze wel correct.

Feitelijk doet deze hetzelfde als die van mij, maar heb jij mij wel, waar ik min of meer ook om vroeg, een andere manier laten zien en heb ik weer wat geleerd.

Code: 
    For i = 1 To 100 Step 10
        With Cells(1, i).Resize(, 10)
            .Merge
            .Borders.LineStyle = xlContinuous
            .HorizontalAlignment = xlCenter
            .Value = Nummer
            .Font.Size = 8
        End With
        
        Nummer = Nummer + 1
    Next i

Toch nog steeds geen antwoord op mijn vraag, maar goed. Het is inderdaad onnodig dus deels wel mijn antwoord. Toch nu wegens jouw reactie. Jij werkt met de For Next. Ik gebruikte de Do While Loop. Kan allebei, maar is er nog een reden voor dat jij voor de For Next koos?

Mijn ander gevonden oplossing is onderstaand. Nou ja... oplossing.... Eigenlijk niet echt een verschil..........

Code: 
        Do While Nummer <= 9
            Cells(1, KolStart).Select
            
            With Range(Cells(1, KolStart), ActiveCell.Offset(0, 9))
                .Merge
                .Borders(xlEdgeRight).LineStyle = xlContinuous
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .HorizontalAlignment = xlCenter
                .Value = Nummer
                .Font.Size = 8
            End With
        
            KolStart = KolStart + 10
            Nummer = Nummer + 1
        Loop
 
Laatst bewerkt:
Toch nog wat extra gewenst.

Ik heb nu de onderstaande code:

Code: 
Sub Add()

    Dim Kolnr, i As Integer
  
    Kolnr = 0
    
    Sheets.Add After:=Sheets(Sheets.Count)
     
    With ActiveSheet.PageSetUp
        .Orientation = xlLandscape 'Afdrukstand=Liggend
        .Zoom = False 'Dient op False te staan om FitToPagesWide -en Tall uit te kunnen voeren.
        .FitToPagesWide = 1 'Breedte
        .FitToPagesTall = False 'Hoogte
    End With
    
    With Range("A1:CV51, A52:CV55")
        .RowHeight = 10
        .ColumnWidth = 1
        .VerticalAlignment = xlCenter
        .Font.Size = 10
        .BorderAround LineStyle:=xlContinuous
    
        For i = 1 To 100 Step 10
            With Cells(1, i).Resize(, 10)
                .Merge
                .HorizontalAlignment = xlCenter
                .Value = Kolnr
                .Borders.LineStyle = xlContinuous
            End With
                    
            Kolnr = Kolnr + 1
        Next i
    
        Range("A5").Select
        
     End With
     
End Sub

In de For Next Loop wil ik eigenlijk ook voor rij 51 hetzelfde als wat er gebeurd in Rij 1. Ik heb al zitten stoeien met:

Code: 
    With Range(Cells(1, i), Cells(51, i).Resize(, 10))

Maar het effect is dan dat er 10 x 10 kolommen worden samengevoegd vanaf rij 1 tot en met rij 51.

Ik heb het ook geprobeerd met een For Loop erin. Dit werkt wel, maar ik geloof dat ik hier weer wat omslachtig word.

Code: 
        For i = 1 To 100 Step 10
            With Cells(1, i).Resize(, 10)
                .Merge
                .HorizontalAlignment = xlCenter
                .Value = Kolnr
                .Borders.LineStyle = xlContinuous
            End With
            
            With Cells(51, i).Resize(, 10)
                .Merge
                .HorizontalAlignment = xlCenter
                .Value = Kolnr
                .Borders.LineStyle = xlContinuous
            End With
            
            Kolnr = Kolnr + 1
        Next i

Hierom heb ik getracht in de With van de For Loop een middels het gebruik van Range deze uit te breiden, maar dat werkt dus kennelijk niet, of ik heb hem niet goed omschreven.

Heeft iemand hier een oplossing voor? Zal ongetwijfeld wel weer iets simpels zijn waar ik niet aan heb gedacht.

Alvast weer bedankt.
 
Laatst bewerkt:
Mogelijk gevonden oplossing met een genestelde For.

Code: 
        For i = 1 To 51 Step 50
            Kolnr = 0
            
            For j = 1 To 100 Step 10
                With Cells(i, j).Resize(, 10)
                    .Merge
                    .HorizontalAlignment = xlCenter
                    .Value = Kolnr
                    .Borders.LineStyle = xlContinuous
                End With
                        
                Kolnr = Kolnr + 1
            Next j
        Next i

Rij 1 en rij 51 moesten exact hetzelfde zijn waarbij ook de nummers.

Ik weet niet of dit logisch is en of het nog ver gezocht is. Eventuele opmerkingen zijn welkom.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan