resize Names(i) op specifieke werkbladen - Client software algemeen

vrijdag 17 november 2017 11:52

Acties:

Topicstarter

Hey,

In mijn excel heb ik ~40 sheets en bijna 100 named ranges. Van die named ranges wil ik er 25 regelmatig resizen naar de laatste cell.

code:

Sub Test1()

  Dim NmdRngNames As Variant
  Dim NmdDynRngName As Variant
  Dim myLastRow As Long
  
  NmdRngNames = Array("J_01", "Grondstof", "Voorblad")

  For Each NmdDynRngName In NmdRngNames
    With ActiveWorkbook.names(NmdDynRngName)
        myLastRow = Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, _
                                                 SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Debug.Print myLastRow
        End With
  Next NmdDynRngName

End Sub

Ik heb alleen geen idee hoe ik de range.find() op het juiste werkblad krijg (volgens mij is dat het probleem).

code:

 With ActiveWorkbook.names(NmdDynRngName).RerfersToRange.name
 With ActiveWorkbook.names(NmdDynRngName).RerfersToRange.cells
 With ActiveWorkbook.names(NmdDynRngName).RerfersToRange.namelocal
 With ActiveWorkbook.names(NmdDynRngName).RerfersToRange.worksheet

Niks lijkt te werken. Of ik pak het natuurlijk verkeerd aan....

Misschien dat hier iemand de fout ziet?

groetjes,

Koen.

Ps: ik probeer .select te vermijden omdat de rest van de code al "veel" tijd in beslag neemt

vrijdag 17 november 2017 12:21

Acties:

breew

De werkbladnaam waar de named range "testrange" staat, krijg je met:

code:

Option Explicit

Sub test()
  Dim ws As String
  ws = Range("testrange").Worksheet.Name
End Sub

Helpt dat?

Ik zou een onderste cel trouwens altijd zoeken met de methode:

code:

1
2
3

With ws
  lonLaatsteRij = .Cells(Rows.Count, "A").End(xlUp).Row
End With

voor de onderste rij met data in kolom A.

en.. er moet (volgens mij) een . (punt) voor Cells... anders doet ie vrij weinig met het werkblad uit het With-statement

code:

1 2	myLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

[ Voor 60% gewijzigd door breew op 17-11-2017 12:40 ]

vrijdag 17 november 2017 13:09

Acties:

MC trouble

Topicstarter

Als ik ws als string instel en dan with ws gebruik krijg ik;

"compilerfout: With-object moet een door een gebruiker gedefinieerd type, object of variant zijn"

Ik heb ThisWorkBook.ws geprobeerd, maar dit werkt ook niet.

met:

code:

1	.Cells(Rows.Count, "A").End(xlUp).Row

Pakt hij ook de cellen met formules en formats geloof ik. Ik was van plan LookIn:=xlValues te gebruiken.

code:

Option Explicit
Sub Test1()

  Dim NmdRngNames As Variant
  Dim NmdDynRngName As Variant
  Dim myLastRow As Long
  Dim myLastColumn As Long
  Dim wb As Workbook
  Set wb = ThisWorkbook
      
  NmdRngNames = Array("J_01", "Grondstof", "Voorblad")

  For Each NmdDynRngName In NmdRngNames
  Dim ws As String
  ws = wb.Range(NmdDynRngName).Worksheet.Name

    With ws
        myLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Debug.Print myLastRow
        Debug.Print ActiveSheet.Name
        
        End With
  Next NmdDynRngName

End Sub

[ Voor 44% gewijzigd door MC trouble op 17-11-2017 13:15 ]

vrijdag 17 november 2017 13:15

Acties:

breew

MC trouble schreef op vrijdag 17 november 2017 @ 13:09:
Als ik ws als string instel en dan with ws gebruik krijg ik;

"compilerfout: With-object moet een door een gebruiker gedefinieerd type, object of variant zijn"

ws moet je definiëren als worksheet (=werkblad), en vervolgens initialiseren met 'Set', zoals voor (bijna?) alle objecten.

code:

Dim ws as Worksheet
Dim strWsNaam as String
Set ws = wb.Range(NmdDynRngName).Worksheet
strWsNaam = ws.Name

[ Voor 31% gewijzigd door breew op 17-11-2017 13:25 ]

vrijdag 17 november 2017 13:25

Acties:

MC trouble

Topicstarter

Ah, en dan with

code:

1
2
3

with strWsNaam
   myLastRow = .Cells.Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
end with

Ik dacht even dat ik ws dubble moest definen of redefinenen

Edit;

Ik krijg nog steeds de zelfde fout met;

code:

Option Explicit
Sub Test1()

  Dim NmdRngNames As Variant
  Dim NmdDynRngName As Variant
  Dim myLastRow As Long
  Dim myLastColumn As Long
  Dim wb As Workbook
  Dim ws As Worksheet
  Dim StrWsNaam As String
  Set wb = ThisWorkbook
  
  
  NmdRngNames = Array("J_01", "Grondstof", "Voorblad")

  For Each NmdDynRngName In NmdRngNames
    Set ws = wb.Range(NmdDynRngName).Worksheet
     StrWsNaam = ws.Name
      With StrWsNaam
        myLastRow = .Cells.Find(What:="*", LookIn:=xlValue, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        Debug.Print myLastRow
        Debug.Print names(NmdDynRngName)
    End With
  Next NmdDynRngName

End Sub

[ Voor 63% gewijzigd door MC trouble op 17-11-2017 13:37 ]

vrijdag 17 november 2017 13:54

Acties:

Lustucru

26 03 2016

Je hebt het hele werkblad niet nodig toch? Een voorbeeldje met veel variabelen om het inzichtelijk te houden:

Visual Basic:

Dim n As Name 'het benoemde bereik
Dim nr As Range 'de cellen in het benoemde bereik
Dim fc As Range 'de eerste cel van het benoemde bereik
Dim lc As Range 'de laatste cel in dezelfde kolom

Set n = ActiveWorkbook.Names("foo")
Set nr = n.RefersToRange

Set fc = nr.Cells(1, 1)
Set lc = nr.EntireColumn.Cells(nr.EntireColumn.Rows.Count, 1).End(xlUp)

n.RefersTo = Range(fc, lc)

Tenzij je natuurlijk alleen wilt resizen als een benoemd bereik op een bepaald blad voorkomt, maar dat maak ik uit je post niet op.

Qua foutmelding:

Dim StrWsNaam As String
StrWsNaam = ws.Name
myLastRow = StrWsNaam.Cells

Je geeft Excel opdracht om in een tekst naar cellen te zoeken. Kan hij niet.

[ Voor 28% gewijzigd door Lustucru op 17-11-2017 14:00 ]

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland

vrijdag 17 november 2017 13:58

Acties:

MC trouble

Topicstarter

Ik heb de name ranges de zelfde naam als de werkbladen gegeven.
Dus de names uit de array gebruik ik voor de names(X) and worksheets(x).

In een eerdere versie van het document mochten alle named ranges opnieuw geresized worden. Deze worden dan naar word gekopieerd. Nu zijn er meer gegevens in de excel sheets gezet (opdrachtgever, adres, inmeter).
Er zijn ook een paar bladen waar alleen een deel van de colom gekopieerd moet worden (B4:F80), dit mogen dus niet geresized worden.

Als de names niet zo veel gebruikt zouden worden in de rest van de sheet zou ik ze eruit gooien en alles opsplitsen in fixed ranges, dynamic named range en single cell. Dan vervolgens alles 'los' kopiëren. Maar nu alles met;

code:

...blablabla...
.names(i).RefersToRange.Copy
...lalala...
Call PasteBookmark(wdDoc, .names(i).Name)

code:

Sub PasteBookmark(wdDoc As Word.Document, strBkMk As String)
Dim wdRng As Word.Range

With wdDoc
    Application.ScreenUpdating = False
       If .Bookmarks.Exists(strBkMk) Then
          On Error GoTo Recopy:
             Set wdRng = .Bookmarks(strBkMk).Range
             wdRng.Paste
          .Bookmarks.Add strBkMk, wdRng
       End If
    End With
  Set wdRng = Nothing
End Sub

[ Voor 80% gewijzigd door MC trouble op 17-11-2017 14:10 ]

vrijdag 17 november 2017 14:23

Acties:

MC trouble

Topicstarter

Ik denk dat ik ergens iets verkeerd uitgelegd/gevraagd heb

Dit is de code die ik om probeer te bouwen zodat hij bij een aantal named ranged de range aanpast;

code:

 With myWorksheet.Cells
        
        'find last row and last column of source data cell range
        myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        myLastColumn = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        
        'specify cell range
        Set myNamedRangeDynamic = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
    
    End With

https://powerspreadsheets.com/vba-create-named-range/

Het is echter gemaakt om named ranges toe te voegen en/of aan te passen. Niet om 25 ranges te resizen tot de laatste cell.

[ Voor 3% gewijzigd door MC trouble op 17-11-2017 14:56 ]

vrijdag 17 november 2017 15:11

Acties:

breew

MC trouble schreef op vrijdag 17 november 2017 @ 14:23:
Ik denk dat ik ergens iets verkeerd uitgelegd/gevraagd heb

Dit is de code die ik om probeer te bouwen zodat hij bij een aantal named ranged de range aanpast;
code:
1
2
3
4
5
6
7
8
9
10
 With myWorksheet.Cells
        
        'find last row and last column of source data cell range
        myLastRow = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        myLastColumn = .Find(What:="*", LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
        
        'specify cell range
        Set myNamedRangeDynamic = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn))
    
    End With
https://powerspreadsheets.com/vba-create-named-range/

Het is echter gemaakt om named ranges toe te voegen en/of aan te passen. Niet om 25 ranges te resizen tot de laatste cell.

Je hoeft natuurlijk niet perse de ranges te resizen.. je kunt ze ook overschrijven met nieuwe ranges op basis van een opgegeven (dynamisch) bereik.. ik denk dat dat makkelijker is dan Range.Resize te gebruiken (in dit geval).

vrijdag 17 november 2017 15:17

Acties:

MC trouble

Topicstarter

Nu je het zegt ja https://tweakimg.net/g/s/frusty.gif

Dat maar eens proberen. Bedankt voor de tip, nu eerst weekend en maandag weer verder :-)

vrijdag 17 november 2017 15:34

Acties:

breew

Om alvast een beetje op weg te helpen (is vast niet de meest efficiënte oplossing, maar goed.. het is bijna weekend

)

Voor:
voor macro

Uitgevoerde code:

code:

Option Explicit

Sub resizeRange()

Dim strRangeNaam As String
Dim namRange As Name
Dim lonLaatsterij As Long
Dim wsRange As Worksheet

strRangeNaam = "testrange"
Set namRange = ActiveWorkbook.Names.Item(strRangeNaam)
Set wsRange = Range(strRangeNaam).Worksheet

With wsRange
  lonLaatsterij = .Cells(Rows.Count, "A").End(xlUp).Row
End With

With namRange
  .RefersTo = wsRange.Range(wsRange.Cells(1, 1), wsRange.Cells(lonLaatsterij, 1))
End With

End Sub

Na:

edit: Lees het nu pas, dit is eigenlijk precies wat @Lustucru ook voorstelt

[ Voor 4% gewijzigd door breew op 17-11-2017 15:36 ]

vrijdag 17 november 2017 15:54

Acties:

Lustucru

26 03 2016

offtopic:
Sterker nog: die van mij is mooier.

Jij kijkt naar de laatste rij in kolom A, ik kijk naar de laatste rij in de eerste kolom van het benoemde bereik. Jouw code faalt als het benoemde bereik niet in kolom A staat.

Of zo je wilt de compacte variant

code:

1
2
3

For Each n In ActiveWorkbook.Names
    n.RefersTo = Range(n.RefersToRange.Cells(1, 1), n.RefersToRange.EntireColumn.Cells(n.RefersToRange.Rows.Count, 1).End(xlUp))
Next n

@MC trouble begin dan maandag maar met na te denken wat je nu precies wilt, want volgens mij is het antwoord nu al meerdere keren gegeven.

[ Voor 23% gewijzigd door Lustucru op 17-11-2017 16:30 ]

De oever waar we niet zijn noemen wij de overkant / Die wordt dan deze kant zodra we daar zijn aangeland

vrijdag 17 november 2017 17:15

Acties:

breew

Lustucru schreef op vrijdag 17 november 2017 @ 15:54:

offtopic:
Sterker nog: die van mij is mooier. Jij kijkt naar de laatste rij in kolom A, ik kijk naar de laatste rij in de eerste kolom van het benoemde bereik. Jouw code faalt als het benoemde bereik niet in kolom A staat.

True $_/-\o_$

maandag 20 november 2017 10:40

Acties:

MC trouble

Topicstarter

Heel erg bedankt allemaal! $_/-\o_$

Het aanpassen van de specifieke ranges met End(xlUp).Row is gelukt.

code:

Sub Test1()

  Dim NmdRngNames As Variant
  Dim myLastRow As Long
  Dim StrWsNaam As String
  Dim strRangeNaam As String
  Dim namRange As Name
  Dim wsRange As Worksheet
  Dim n As Variant
  
  NmdRngNames = Array("J_01", "Grondstof", "Voorblad")

For Each n In NmdRngNames

strRangeNaam = n
Set namRange = ActiveWorkbook.names.Item(strRangeNaam)
Set wsRange = Range(strRangeNaam).Worksheet

  With wsRange
    myLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
  End With
  With namRange
    .RefersTo = wsRange.Range(wsRange.Cells(1, 1), wsRange.Cells(myLastRow, 1))
  End With
Next

End Sub

De ranges beginnen wel allemaal in column "A", maar de laatste cel staat niet altijd daar. Dus ik denk dat ik toch vast zit aan ".find(" methode.

code:

  With wsRange
    myLastRow = .Columns("A:Z").Find(What:="*", SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row
  End With
  With namRange
    .RefersTo = wsRange.Range(wsRange.Cells(1, 1), wsRange.Cells(myLastRow, 1))
  End With

Het werkt en bedank voor de hulp/tips $_/-\o_$ $_/-\o_$ $_/-\o_$

maandag 20 november 2017 12:03

Acties:

breew

MC trouble schreef op maandag 20 november 2017 @ 10:40:
De ranges beginnen wel allemaal in column "A", maar de laatste cel staat niet altijd daar. Dus ik denk dat ik toch vast zit aan ".find(" methode.
code:
1
2
3
4
5
6
  With wsRange
    myLastRow = .Columns("A:Z").Find(What:="*", SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row
  End With
  With namRange
    .RefersTo = wsRange.Range(wsRange.Cells(1, 1), wsRange.Cells(myLastRow, 1))
  End With
Het werkt en bedank voor de hulp/tips

Dat hoeft niet persé... De manier die @Lustucru aangaf in Lustucru in "resize Names(i) op specifieke werkbladen" voor het vinden van de laatste rij in de eerste kolom van een bereik, kun je eenzelfde manier gebruiken om de laatste kolom in een bereik te vinden, of om door elke kolom van een bereik te for-loopen..

Aan de andere kant: als het nu werkt.. vooral niet meer aankomen

maandag 20 november 2017 13:53

Acties:

MC trouble

Topicstarter

Er is maar één tabblad waar het aantal kolommen dynamisch moet zijn, die heb ik er maar los bijgezet

Ik zit nu alleen nog met de tijd die het hele proces duurt. Mijn gekietelde i7-6700k 4,5GHz doet er 21 seconde over om een bijna leeg Excel document aan te passen en alles te kopiëren naar Word (18 seconde voor het kopiëren). Screenupdating en event zijn uitgezet tijdens de macro, maar in Word lijkt het scherm nog wel te worden geupdate. Iemand misschien een tip?

...de oude first gen i5 en i7 processors krijgen het in ieder geval nog zwaar

Pagina: 1

Reageer