Help!

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

Hulp bij posten

Recente topics

Auteur Topic: Aangepast lint in Excel  (gelezen 4074 keer)

0 leden en 1 gast bekijken dit topic.

Offline BlackDevil

  • Oplosser
  • ****
  • Berichten: 602
  • Geslacht: Vrouw
  • Oplossing.be
Re: Aangepast lint in Excel
« Reactie #15 Gepost op: 13 augustus 2022, 14:39:24 »
Hey MollyVH,

Bedankt voor dit mooie code-blokje.
Bij het uitvoeren kreeg ik op de msgbox "3,90625E-03 sec." en toen ik op het werkblad "patroon" ging kijken was er bij geen enkele volledige groene rij een "x" geplaatst...

Uiteraard ben ik sinds mijn laatste post niet gestopt met brainstormen terwijl ik aan het borduren was en toen bedacht ik dat mijn initieel idee (om de afgewerkte cellen te tellen) niet nodig was op beide werkbladen en dus beperkt kon worden op het werkblad "afgewerkt" waarbij ik wél via een formule kon tellen, nl de AANTAL.ALS formule op basis van de waarde " " (spatie).
Ik heb dit dan eens uitgetest door vervolgens met 2 kleine loops die "hulp-kolom" op werkblad "afgewerkt"  te doorlopen om het begin en einde te bepalen volgens het aantal dat vermeld werd.
Als ik met die kleine toevoeging dan mijn macro laat lopen (heb er ook eventjes die twee lijntjes code ivm timer aan toegevoegd) dan kreeg ik op de msgbox "0,21875 sec." te zien.

Doordat na jouw macro te laten lopen die "x" niet geplaatst word en er dus waarschijnlijk ergens iets mis gaat vermoed ik dat dat de reden is dat de timer bij jouw macro op bijna 4 sec staat?


groetjes,
BlackDevil
Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz / RAM : 8,00 GB (7,89 GB beschikbaar) / 64-bits besturingssysteem, x64-processor / Intel(R) 7 Series Chipset Family SATA AHCIController / Qualcomm Atheros AR8161 PCI-E Gigabit Ethernet Controller (NDIS 6.30) / Qualcomm Atheros AR9485 Wireless Network Adapter / HGST HTS541010A9E680 / Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP OfficeJet 3831
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Volledig lid
  • *****
  • Berichten: 211
  • Hey, ik ben nieuw hier !
Re: Aangepast lint in Excel
« Reactie #16 Gepost op: 13 augustus 2022, 15:30:14 »
Euhhh, kleine correctie om mee te beginnen: mijn macro is dus gestopt na 0,0039 seconden (zie E-03).

En verder: als er met dezelfde macro bij jou geen enkele x wordt geplaatst en bij mij wel, dan is er veeleer iets met jouw werkblad aan de hand.
Zie je het misschien wél zitten om eens enkel je blad 'patroon' in een nieuw macroloos bestand te steken en als bijlage te sturen? Dan plak ik dat in het mijne om te kijken wat er scheelt.

In mijn vorige post nog niet meegegeven: de spaties op "afgewerkt" zetten en erop checken had ik afgeschaft omdat de meerwaarde moeilijk te achterhalen valt. Die zal telkens anders zijn naargelang hoe op dat moment "patroon" eruit zit, groot zal de meerwaarde niet zijn, ze kan wel klein, onbestaand of zelfs negatief  :D zijn.

Groetjes,
Molly
   

Offline BlackDevil

  • Oplosser
  • ****
  • Berichten: 602
  • Geslacht: Vrouw
  • Oplossing.be
Re: Aangepast lint in Excel
« Reactie #17 Gepost op: 13 augustus 2022, 17:25:40 »
Hey MollyVH,

Ik denk dat ik de oorzaak ivm het kruisje heb gevonden.
In mijn origineel bestand voer ik de macro ‘afgwerkt’ altijd uit wanneer het werkblad “afgewerkt” actief staat zodat ik onmiddellijk het resultaat kan zien. Toen ik jouw macro ging testen stond dus ook het werkblad “afgewerkt” actief en werden de kruisjes niet geplaatst.
Ik heb dan jouw macro eens uitgetest toen het werkblad “patroon” actief stond en toen werden de kruisjes wel vermeld nadat ik de msgbox sloot.
PS : Bij de laatste test klokte de timer in jouw macro wel nog steeds af op “2,0625 sec.”

Ivm al dan niet een meerwaarde te zijn om de spaties te noteren (en tellen) veranderen de aantallen inderdaad naarmate het borduurwerk vordert maar aangezien er via een formule geteld word, word dit automatisch aangepast na elke bijwerking waardoor bij de volgende bijwerking de variabelen ‘begin’ en ‘einde’ automatisch het correcte (nieuwe) rijnummer hebben om de loop te starten.

Ik ga nog eventjes beide macro’s blijven vergelijken mbt snelheid naargelang het borduurwerk vordert zodat ik kan ondervinden welke praktisch gezien het snelst en handigste werkt.

Ontzettend hard bedankt voor jouw input en de tijd die je er hebt ingestoken, ik heb zeer veel nuttigs bijgeleerd alweer. _/-\o_ :thumbsup:


Groetjes,
BlackDevil
Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz / RAM : 8,00 GB (7,89 GB beschikbaar) / 64-bits besturingssysteem, x64-processor / Intel(R) 7 Series Chipset Family SATA AHCIController / Qualcomm Atheros AR8161 PCI-E Gigabit Ethernet Controller (NDIS 6.30) / Qualcomm Atheros AR9485 Wireless Network Adapter / HGST HTS541010A9E680 / Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP OfficeJet 3831
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Volledig lid
  • *****
  • Berichten: 211
  • Hey, ik ben nieuw hier !
Re: Aangepast lint in Excel
« Reactie #18 Gepost op: 13 augustus 2022, 18:09:50 »
Hallo BlackDevil,

Mea culpa dus wat het plaatsen van de x betreft  :-[
Als ik het juist had gedaan maakt het geen verschil welk werkblad actief is, er moest 'gewoon' nog een punt vóór de instructie die de x zet (haast en spoed...)

Groetjes, en nog veel macro- en borduurplezier,
Molly

Offline JEC

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 348
Re: Aangepast lint in Excel
« Reactie #19 Gepost op: 17 augustus 2022, 16:29:34 »
Wat vind je van deze macro (zie bijlage), hij doet alles (met veel meer data) in 0,1 seconde  :)



« Laatst bewerkt op: 17 augustus 2022, 16:37:15 door JEC »

Offline BlackDevil

  • Oplosser
  • ****
  • Berichten: 602
  • Geslacht: Vrouw
  • Oplossing.be
Re: Aangepast lint in Excel
« Reactie #20 Gepost op: 17 augustus 2022, 16:55:35 »
Hey JEC,

Bedankt voor jouw reactie en aangereikte oplossing.
Echter bij jouw macro zet hij gewoon het volledige gebruikte bereik over naar het werkblad "afgewerkt", ongeacht of de achtergrond groen ziet, wat dus niet de bedoeling is.
Bedoeling is dat hij enkel de cellen met groene achtergrond (= markering voor reeds afgewerkte steken) overzet naar het werkblad "afgewerkt" zodat ik
dit kan vergelijken met mijn fysiek borduurwerk om alzo makkelijker en sneller eventuele foutjes op te sporen.

groetjes,
BlackDevil
Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz / RAM : 8,00 GB (7,89 GB beschikbaar) / 64-bits besturingssysteem, x64-processor / Intel(R) 7 Series Chipset Family SATA AHCIController / Qualcomm Atheros AR8161 PCI-E Gigabit Ethernet Controller (NDIS 6.30) / Qualcomm Atheros AR9485 Wireless Network Adapter / HGST HTS541010A9E680 / Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP OfficeJet 3831
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline JEC

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 348
Re: Aangepast lint in Excel
« Reactie #21 Gepost op: 17 augustus 2022, 17:09:22 »
Als je macro "jec" vervangt door onderstaande zou het opgelost moeten zijn. 1 regeltje extra doet de truc ;)

Sub jec()
 Set ar = Sheets(1).ListObjects(1).DataBodyRange
 Set sht = Sheets("Afgewerkt")
 
 Application.ScreenUpdating = False
 Sheets("patroon").UsedRange.Copy Sheets("Afgewerkt").Range("A1")
 
 No_Borders
 
 For Each it In ar.Columns(6).Cells
   With Application.FindFormat
     .Clear
     .Font.Name = it.Font.Name
     .Interior.Color = vbGreen
   End With
   
   With Application.ReplaceFormat
     .Clear
     With .Borders
       For Each sp In Array(xlDiagonalUp, xlDiagonalDown)
          .Item(sp).Color = RGB(it.Offset(, -4), it.Offset(, -3), it.Offset(, -2))
          .Item(sp).LineStyle = xlContinuous
          .Item(sp).Weight = 4
       Next
     End With
   End With
   Sheets("Afgewerkt").UsedRange.Replace it, "", SearchFormat:=True, ReplaceFormat:=True
 Next

 sht.UsedRange.Interior.Pattern = xlNone
 sht.UsedRange.ClearContents
End Sub

Offline BlackDevil

  • Oplosser
  • ****
  • Berichten: 602
  • Geslacht: Vrouw
  • Oplossing.be
Re: Aangepast lint in Excel
« Reactie #22 Gepost op: 17 augustus 2022, 18:16:43 »
Hey JEC,

Hartelijk dank voor de aanpassing, in jouw kopie van het voorbeeldbestand deed hij er bij mij nu 0,05 sec over  :thumbsup:.
Mijn origineel bestand is een pak groter, nl. 216 kolommen en 270 rijen met 29 kleuren dus ik ga straks na het avondeten even uittesten
hoeveel seconden hij er in het werkelijke bestand over doet en laat het hier dan nog wel weten.

groetjes,
BlackDevil
Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz / RAM : 8,00 GB (7,89 GB beschikbaar) / 64-bits besturingssysteem, x64-processor / Intel(R) 7 Series Chipset Family SATA AHCIController / Qualcomm Atheros AR8161 PCI-E Gigabit Ethernet Controller (NDIS 6.30) / Qualcomm Atheros AR9485 Wireless Network Adapter / HGST HTS541010A9E680 / Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP OfficeJet 3831
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline JEC

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 348
Re: Aangepast lint in Excel
« Reactie #23 Gepost op: 17 augustus 2022, 18:33:48 »
De code blijft snel omdat er naast het aflopen van de rijen op het eerste tabblad, geen loops in zitten.

Formatting wordt direct benaderd via find en replaceformat :thumbsup:

Offline BlackDevil

  • Oplosser
  • ****
  • Berichten: 602
  • Geslacht: Vrouw
  • Oplossing.be
Re: Aangepast lint in Excel
« Reactie #24 Gepost op: 17 augustus 2022, 20:13:11 »
ja, inderdaad, dat is wat ik zocht omdat ik weet dat loops voor heel wat vertraging kunnen zorgen...

Heb het even in mijn origineel bestand uitgetest en ja, 0,29 seconden om telkens het hele patroon opnieuw over te zetten. :)

groetjes,
BlackDevil
Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz / RAM : 8,00 GB (7,89 GB beschikbaar) / 64-bits besturingssysteem, x64-processor / Intel(R) 7 Series Chipset Family SATA AHCIController / Qualcomm Atheros AR8161 PCI-E Gigabit Ethernet Controller (NDIS 6.30) / Qualcomm Atheros AR9485 Wireless Network Adapter / HGST HTS541010A9E680 / Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP OfficeJet 3831
Bullguard Premium Protection / Office Pro Plus 2016 NL

Offline MollyVH

  • Excel-Expert
  • Volledig lid
  • *****
  • Berichten: 211
  • Hey, ik ben nieuw hier !
Re: Aangepast lint in Excel
« Reactie #25 Gepost op: 18 augustus 2022, 09:21:26 »
@ JEC,

Mooie en simpele code  :thumbsup:
Dat gaat zo met wie 100% autodidact is, men mist al eens iets... ik was nooit eerder Find- of ReplaceFormat tegengekomen, zal zeker nog van pas komen.

Juist omdat het zo zelden gebeurt is het extra leuk als ik jou eens iets kan bijbrengen (al is het hier iets heel simpel).
Als we de diagonalen buiten beschouwing laten zijn er 6 mogelijke randen. Als die alle 6 dezelfde behandeling nodig hebben volstaat 1 instructie.
Dus:
     With Sheets("Afgewerkt").Cells
          .Borders(xlEdgeLeft).LineStyle = xlNone
          .Borders(xlEdgeTop).LineStyle = xlNone
          .Borders(xlEdgeBottom).LineStyle = xlNone
          .Borders(xlEdgeRight).LineStyle = xlNone
          .Borders(xlInsideVertical).LineStyle = xlNone
          .Borders(xlInsideHorizontal).LineStyle = xlNone
     End With

kan ook zo:
Sheets("Afgewerkt").Cells.Borders.LineStyle = xlNone
Mvg,
Molly

Offline JEC

  • Excel-Expert
  • Ervaren lid
  • *****
  • Berichten: 348
Re: Aangepast lint in Excel
« Reactie #26 Gepost op: 18 augustus 2022, 10:33:16 »
Dat is mooi! Ik had deze rechtstreeks gekopieerd zonder te kijken of eea korter kon :)

Offline BlackDevil

  • Oplosser
  • ****
  • Berichten: 602
  • Geslacht: Vrouw
  • Oplossing.be
Re: Aangepast lint in Excel
« Reactie #27 Gepost op: 18 augustus 2022, 10:58:49 »
*update*

Omdat ik nog een andere macro heb die afhankelijk is van de waarde “ “ (spatie), in de cellen die gekleurde diagonale borders hebben, heb ik de macro van JEC lichtjes aangepast en er ook meteen de aanpassing van MollyVH mbt de ‘no borders’ aan toegevoegd met onderstaande macro als eindresultaat.

Sub afgewerkt()
 Set ar = Sheets("DMCtoRGB").ListObjects(1).DataBodyRange
 Set sht = Sheets("afgewerkt")
 
 Application.ScreenUpdating = False
 Sheets("patroon").UsedRange.Copy Sheets("afgewerkt").Range("A1")
 
 Sheets("afgewerkt").Cells.Borders.LineStyle = xlNone
'  t = Timer

 For Each it In ar.Columns(6).Cells
   With Application.FindFormat
     .Clear
     .Font.Name = it.Font.Name
     .Interior.Color = vbGreen
   End With
   
   With Application.ReplaceFormat
     .Clear
     With .Borders
       For Each sp In Array(xlDiagonalUp, xlDiagonalDown)
          .Item(sp).Color = RGB(it.Offset(, -4), it.Offset(, -3), it.Offset(, -2))
          .Item(sp).LineStyle = xlContinuous
          .Item(sp).Weight = 4
       Next
     End With
   End With
   Sheets("afgewerkt").UsedRange.Replace it, " ", SearchFormat:=True, ReplaceFormat:=True
 Next

sht.UsedRange.Interior.Pattern = xlNone
sht.UsedRange.Font.Color = vbWhite
'  MsgBox Format(Timer - t, "0.00\s")

End Sub

PS : Ik heb de font.color van de sht.UsedRange gewoon op vbWhite gezet (ipv een volledige ClearContents toe te passen) omdat ik niet meteen vond hoe ik enkel de cellen met een symbool moest leegmaken.

Hartelijk dank aan JEC en MollyVH voor jullie aangereikte oplossingen, ik heb er weer héél wat van bijgeleerd ;-). :thumbsup:

Groetjes,
BlackDevil
Windows 10 Home / Intel(R) Core(TM) i3-3110M CPU@ 2.40GHz 2.40GHz / RAM : 8,00 GB (7,89 GB beschikbaar) / 64-bits besturingssysteem, x64-processor / Intel(R) 7 Series Chipset Family SATA AHCIController / Qualcomm Atheros AR8161 PCI-E Gigabit Ethernet Controller (NDIS 6.30) / Qualcomm Atheros AR9485 Wireless Network Adapter / HGST HTS541010A9E680 / Seagate Backup+ Hub 6TB / Seagate BUP Slim 2TB / Seagate Expansion Desk 5TB / HP OfficeJet 3831
Bullguard Premium Protection / Office Pro Plus 2016 NL

 


www.combell.com