naam (bereik) toekennen via vba

[anoniem]

wie kan me helpen met het volgende op een werkblad met 6 kolommen heb ik ongeveer 450 rijen gevuld. In kolom A staan de groepen , in kolom B de subgroepen en in de overige kolommen de gegevens. Ik heb gesorteerd op kolom A, dus groep1, groep2 etc. Nu wil ik middels vba code schrijven die automatisch het bereik bepaalt van de verschillende groepen en ze de naam geeft die in kolom A staat. Het aantal rijden per groep kan per maand verschillend zijn, het aantal kolommen is standaard. Dus met 1 druk op de knop bepaalt ie het bereik van groep1 en geeft dat bereik de naam 'groep1', vervolgens gaat ie naar groep2 etc tot alle groepen doorlopen en benoemd zijn.

[anoniem]

Hallo, het is mij nog niet duidelijk wat je wilt bereiken. De groepen in kolom A staan al gesorteerd. Moeten dan de cellen die als inhoud groep1 bevatten een naam krijgen (Range name)? En dan, wat wil je met die namen. Fred

[anoniem]

tja dat wordt inderdaad niet duidelijk. het is de bedoeling om elke groep naar een aparte werkmap te verplaatsen en dan binnen die groep elke subgroep op een apart werkblad te zetten. Een groep1 is bijv (a1:e15), groep2 (a16:e24) etc. Door (a1:e15) de naam 'groep1' te geven leek het me makkelijker omdat ik dan naar het te verplaatsen deel kan verwijzen door de naam te gebruiken in de code. Maar een maand later kunnen de groepen meer of minder gegevens bevatten, dus is h et aantal rijen variabel. een tweede reden is dat ik de opdracht Naam invoegen (dus 'bereiken definieren') wil automatiseren. IK kan natuurlijk het eerste blok met de hand selecteren en vervolgens van naam voorzien en dan het volgende blok etc maar, dat moet toch ook anders kunnen ? martin

[anoniem]

Martin, ik heb het volgende bedacht om je variabele bereiken een naam te geven. [code:1:57373d2400] Sub indelen() Dim Ws As Worksheet, R As Range, Rij1, Rij2, Kolom, Groep, NieuweGroep, AantalGroepen As Integer Dim Begin, Eind As Range Dim GroepsNaam As String Set Ws = Worksheets(ActiveSheet.Name) Rij1 = 0 Groep = 0 For Each R In Ws.Range("groepen") Kolom = R.Column R.Select If Groep = 0 Then Rij1 = R.Row NieuweGroep = Val(Right$(R.Value, 1)) If NieuweGroep > Groep Then Groep = NieuweGroep If Groep > 1 Then Rij2 = R.Offset(-1, 0).Row GroepsNaam = "groep" & Trim$(Str$(Groep - 1)) Ws.Range(Cells(Rij1, Kolom), Cells(Rij2, Kolom)).Name = GroepsNaam Rij1 = R.Row End If Else If CellType(R) = "Blank" Then Rij2 = R.Offset(-1, 0).Row GroepsNaam = "groep" & Trim$(Str$(Groep)) Ws.Range(Cells(Rij1, Kolom), Cells(Rij2, Kolom)).Name = GroepsNaam Exit Sub End If End If R.Font.ColorIndex = Groep + 10 Next R End Sub [/code:1:57373d2400] Helpt dit? Fred

[anoniem]

Martin, ik zie dat ik wat overbodige code heb laten staan. Wat misschien ook niet duidelijk is dat ik je hele kolom A de naam "groepen"heb gegeven. De code zoek dan dit hele bereik af op een naam die met groep begint, totdat een blanco cel tegengekomen wordt. Als je nog vragen hebt, hoor ik het wel. Fred

[anoniem]

:D ik ga er mee aan de slag. Ben benieuwd. martin

[anoniem]

fred, het loopt als een trein als ik kolom A voorzie van namen als groep1-groepx. Wat wel opviel is dat groep10 bij groep1 wordt aangeplakt. Alleen bestaat op mijn werkblad kolom A uit namen als Administratie, BVT, Interne etc. Gewone (afdelings)namen dus. Ik zal eerst zelf eens door puzzelen of ik daar een oplossing voor kan vinden. ( suggesties zijn natuurlijk altijd welkom ..... 8) martin

[anoniem]

Martin, je zou het zo kunnen aanpassen: [code:1:7714bbfb85] Sub indelen() Dim Ws As Worksheet Dim BeginRij, EindRij, Kolom, AantalGroepen As Integer Dim R, Begin, Eind As Range Dim DezeGroep, VorigeGroep As String Set Ws = Worksheets(ActiveSheet.Name) BeginRij = 0 VorigeGroep = "" AantalGroepen = 0 For Each R In Ws.Range("groepen") Kolom = R.Column DezeGroep = R.Value If DezeGroep <> VorigeGroep Then ' nieuwe groep If VorigeGroep <> "" Then ' vorige groep is compleet EindRij = R.Offset(-1, 0).Row Ws.Range(Cells(BeginRij, Kolom), Cells(EindRij, Kolom)).Name = VorigeGroep Ws.Cells(AantalGroepen, 4).Value = VorigeGroep VorigeGroep = DezeGroep BeginRij = R.Row ' begin nieuwe serie AantalGroepen = AantalGroepen + 1 Else ' begin van de eerste serie BeginRij = R.Row AantalGroepen = AantalGroepen + 1 VorigeGroep = DezeGroep End If Else If CellType(R) = "Blank" Then EindRij = R.Offset(-1, 0).Row Ws.Range(Cells(BeginRij, Kolom), Cells(EindRij, Kolom)).Name = DezeGroep Exit Sub End If End If R.Font.ColorIndex = AantalGroepen + 10 ' alleen maar om het effekt te zien Next R End Sub [/code:1:7714bbfb85] Dit gaat ervan uit dat de groepen gesorteerd zijn, anders werkt het niet. gr Fred

[anoniem]

Fred Ik heb het helemaal werkend gekregen. Zelfs het schrijven van de code die groep1 tot x toevoegd in een ingevoegde kolom A. Dit omdat de indeling moet geschieden aan de hand van diverse units. :D Het enig opmerkelijke waar ik mee bleef zitten was het feit dat bij mij groep10 bij groep1 werd toegevoegd. Zou wel door de 0 komen dacht ik maar met groep11 ging het ook enigzins fout. Ik kan het op dit moment echter niet reproduceren omdat ik niet op mijn werk zit. :o Nog een vraag van mijn kant: waar dient de functie celltype voor. Om te kijken of een cel leeg is heb ik toch niet zoveel code nodig? Maar bedankt voor je medewerking. martin

[anoniem]

Martin, in de oorspronkelijke code werd het laatste karakter als getal berekend. Met getallen groter dan 9 gaat dat fout. In m'n laatste code gebruik ik dat niet meer, en wordt de hele tekst vergeleken. Had je die al geprobeerd? De functie celltype is niet echt nodig om een lege cel te vinden. Dat kan ook met de cel functie =isleeg. groet Fred

[anoniem]

:oops: De vorige code geheel over het hoofd gezien. Het naamgeven houdt inderdaad op bij groep9. Ga nu meteen aan de slag met de nieuwe code. Ik moet wel gebruik blijven maken van groep1 tot x vanwege de notatiefouten die in de huidige naamgeving zitten (spaties en bijzondere tekens, die niet worden geaccepteerd.) Kom er nog op terug :D

[anoniem]

Fred, geheel volgens verwachting werkt het als een tierelier. Bedankt. martin

[anoniem]

:D Martin, goed te horen dat het werkt. Dat het niet werkt met bijzondere karakters verbaasd met niet. Je probeert een bereik een naam te geven, dan zal het 'pure' tekst moeten zijn. Heb je die karakters nodig? Fred

[anoniem]

nee ik eigenlijk niet. Je kunt overigens denken aan namen als: 3Oost vanS, O&D, of namen met meer dan 25 tekens. Maar de gebruikers willen deze namen wel graag in hun oorspronkelijke staat houden. Deze wordt bijv. gebruikt als naam voor het werkblad. Maar ik heb het goed op kunnen lossen door de afdelingen te sorteren en vervolgens, in VBA, per soort een groepsnummer te laten toekennen die ik gebruik om de bereiken te definieren. Nadat de 92 afdelingen zijn 'verspreidt' over diverse medewerkers en per afdeling op 1 blad staan kan de naamsverwijziging weer verdwijnen.