Help!

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

Hulp bij posten

Recente topics

Auteur Topic: Winnaarslijst aanpassen per trekking  (gelezen 7058 keer)

0 leden en 1 gast bekijken dit topic.

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Winnaarslijst aanpassen per trekking
« Gepost op: 22 juli 2020, 15:59:47 »
Aan alle helpers,

Hier ben ik weer met een vraag die verder gaat op de vraag namen uit lijst filteren.
(misschien kan er gebruik gemaakt worden van stukken code uit de vorige vraag??)
Wat ze zouden willen bereiken is het volgende
1)Via vba Kolom B telkens vernieuwen en de reeds bestaande kolommen laten opschuiven naar rechts (is al in orde)
De nieuwe kolom voorzien van een vervolgtitel (WINNAARS pakket 1,WINNAARS pakket 2 ENZ.)  dus telkens één nummer verhogen.

2) “De namen in Kolom B worden telkens manueel ingevuld” dit zijn de nieuwe winnaars.
de code aanpassen die de dubbels (in kolom A en B) wegfilterd maar enkel deze in kolom A  zodat bij de volgende trekking de namen in kolom B mee opschuiven als er één nieuwe kolom B geplaatst word en dit tot alle namen in kolom A aan bod zijn gekomen.

3)Alle kolommen verwijderen behalve kolom A en B (is al in orde)
 kolom B nieuwe Titel geven WINNAARS PAKKET 1

Ps in bijlage een reeds ingevulde file.
De macro's staan in de beginfase,moeten nog verder aangepast worden maar daar heb ik jullie voor nodig :-[ :-[
    Indien onduidelijk laat het maar weten


    Mvg,lco



Offline cow18

  • Ervaren lid
  • ***
  • Berichten: 340
  • Geslacht: Man
  • Oplossing.be
Re: Winnaarslijst aanpassen per trekking
« Reactie #1 Gepost op: 23 juli 2020, 03:54:12 »
Private Sub CommandButton2_Click()
   Columns("B:B").Insert                         'kolom invoegen
   With Range("C1")                              'kijk naar C1
      If Len(.Value) > 0 Then                    'staat er iets in
         sp = Split(.Value)                      'inhoud splitsen op de spaties
         If IsNumeric(sp(UBound(sp))) Then sp(UBound(sp)) = sp(UBound(sp)) + 1   'is laatste stukje numeriek, tel er dan 1 bij
         .Offset(, -1).Value = Join(sp)          'voeg de boel weer samen en zet het in B1
      End If
   End With
End Sub

Private Sub CommandButton3_Click()
   Sheets("blad1").UsedRange.Offset(, 1).ClearContents   'inhoud leegmaken
   Range("B1").Value = "WINNAARS PAKKET 1"       'kop er in zetten
   ActiveWorkbook.Save
End Sub

eigenschappen van je knoppen mogelijks wijzigen (besturingselement opmaken>kenmerken)
- vinkje weg bij "object afdrukken"
- verplaatsing en formaat niet gerelateerd aan cellen

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #2 Gepost op: 23 juli 2020, 09:08:43 »
cow18,

Bedankt voor code werkt zoals het moet. :thumbsup: :thumbsup:

graag nog een aanpassing,als je de lijsten leegmaakt zouden ook de lege kolommen moeten verdwijnen  :-\

Als de dubbels worden verwijderd "na het opzoeken" moet dit enkel in kolom A gebeuren en moeten de namen in kolom B blijven staan en niet meer naar kolom C verplaatst worden

zie bijlage


     mvg,lco

Offline cow18

  • Ervaren lid
  • ***
  • Berichten: 340
  • Geslacht: Man
  • Oplossing.be
Re: Winnaarslijst aanpassen per trekking
« Reactie #3 Gepost op: 23 juli 2020, 09:46:22 »
in 2 keer, eerst alles vanaf B leegmaken en daarna alles vanaf C verwijderen
De bijlage lijkt de oude versie, dus zonder wijzigingen aan de eigenschappen van je knoppen, waardoor de knoppen mee naar links verschuiven Private Sub CommandButton5_Click()
   With Sheets("blad1")
      .UsedRange.Offset(, 1).ClearContents       'vanaf 2e kolom inhoud leegmaken
      .UsedRange.Offset(, 2).Delete              'vanaf 3e kolom verwijderen
      .Range("B1").Value = "WINNAARS PAKKET 1"   'kop er in zetten
   End With
   ActiveWorkbook.Save
End Sub

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #4 Gepost op: 23 juli 2020, 10:14:27 »
cow18,

Bedankt voor de aanpassing :thumbsup: :thumbsup:

Bij jou lijkt alles zo simpel, voor mij is dit chinees "dus zeer tevreden dat er forums zoals oplossing.be bestaan"

    mvg,lco

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #5 Gepost op: 23 juli 2020, 10:40:23 »
cow18,

ik vind fout niet (waarschijnlijk verkeerd gekopieerd,kun jij eens kijken aub.
zie bijlage wat er gebeurd als dubbels wil wissen

ps:ben waarschijnlijk 2 files dooreen aan het halen.



   mvg,lco

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #6 Gepost op: 23 juli 2020, 11:27:16 »
cow18,

ik heb enkele files weggegooid omdat alles door elkaar gebruikt werd sorry daarvoor. :-[
ben het volledig in soep aan het draaien,ga het even laten rusten loop verder achteruit dan voor uit :-[ :-[ :-[

wat ik opgemerkt heb is dat wanneer de lijst word leeggemaakt de breedte van de kolommen blijft staan wat resulteert in mijn opmerking uit vorige post,dus bij leegmaken de kolommen terug in originele breedte zetten. ::)

     mvg,lco

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #7 Gepost op: 23 juli 2020, 11:53:54 »
cow18,

hier ben ik weer,hopelijk met de goede file nu. :-[

Heb het intussen in orde gekregen.  ;)

ps: ik leer langzaam hé ;D ;D
Bedankt voor alles en tot later :thumbsup:
    mvg,lco

Offline cow18

  • Ervaren lid
  • ***
  • Berichten: 340
  • Geslacht: Man
  • Oplossing.be
Re: Winnaarslijst aanpassen per trekking
« Reactie #8 Gepost op: 23 juli 2020, 21:02:29 »
1e rode regel zorgt er voor dat de nieuw ingevoegde kolom dezelfde kolombreedte heeft als die van kolom A, vervang anders het stuk na het gelijkheidsteken door jouw 8.11 als je het liever anders ziet/

De 2e rode regel is eerder muggezifterij, de macro-recorder maakt er een zootje van een maakt er een onoverzichtelijke boel van.
Als je de ene regel select krijgt en de volgende regel selection, veeg dan die 2 tov elkaar weg en het wordt een stuk leesbaarder, misschien voorlopig voor jou nog niet, maar dat komt.
Citaat
Private Sub CommandButton4_Click()

   Columns("B:B").Insert                         'kolom invoegen
  Columns("B").ColumnWidth = Columns("A").ColumnWidth   'kolombreedte van B identiek aan die van A
 With Range("C1")                              'kijk naar C1
      If Len(.Value) > 0 Then                    'staat er iets in
         sp = Split(.Value)                      'inhoud splitsen op de spaties
         If IsNumeric(sp(UBound(sp))) Then sp(UBound(sp)) = sp(UBound(sp)) + 1   'is laatste stukje numeriek, tel er dan 1 bij
         .Offset(, -1).Value = Join(sp)          'voeg de boel weer samen en zet het in B1
      End If
   End With
End Sub

Private Sub CommandButton5_Click()
   With Sheets("blad1")
      .UsedRange.Offset(, 1).ClearContents       'vanaf 2e kolom inhoud leegmaken
      .UsedRange.Offset(, 2).Delete              'vanaf 3e kolom verwijderen
      .Range("B1").Value = "WINNAARS PAKKET 1"   'kop er in zetten
      Columns("C:AT").ColumnWidth = 8.11
   
   Range("A1").Select
   End With
   ActiveWorkbook.Save
End Sub

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #9 Gepost op: 23 juli 2020, 21:16:24 »
cow18,

ga er mij is mee bezig houden,gelijk je zegt begrijpen gaat wat trager.

bedankt voor het stuk code geeft mij wederom een tijdje om het te ontcijferen ::)


     mvg,lco

Offline cow18

  • Ervaren lid
  • ***
  • Berichten: 340
  • Geslacht: Man
  • Oplossing.be
Re: Winnaarslijst aanpassen per trekking
« Reactie #10 Gepost op: 24 juli 2020, 01:12:53 »
ok.
nog eventjes terugkomen op die muggezifterij en in het licht van gisteren, een activate of een select is eigenlijk ook tijdrovend, dus behalve nadelig voor de leesbaarheid, is het ook niet efficient.
Zie eenvoudig voorbeeldje met 1000 keer een kolombreedte aanpassen = bijna maal 3 bij mij
Maar nu nog iets extra, als je ook nog zegt dat tussendoor het scherm niet moet aangepast worden(screenupdating=false), dan win je nog een keer tijd (meer dan 10 keer sneller dan de vorige tijd).

PS, kijk maar tot het 1e cijfer, max 2e, na de komma voor de grootte-orde, al de rest is zever.
bv; het 4e methode, scherm bevriezen zonder select, bij mij is 0.09 sec, die tijdsmeting is, behalve dat ze razend snel is, nauwelijks betrouwbaar.
Sub MetSelect()
   t0 = Timer                                    'start de klok
   For i = 1 To 1000                             '1000 loops
      Columns(i).ColumnWidth = 10                'kolombreede van een bepaalde kolom
   Next

   t1 = Timer                                    'tussentijd
   For i = 1 To 1000                             'weer 1000 loops
      Cells(1, i).EntireColumn.Select            'eerst die kolom selecteren
      Selection.ColumnWidth = 11                 'kolombreedte
   Next

   t2 = Timer                                    'tussentijd
   Application.ScreenUpdating = False            'beeld tussendoor niet aanpassen
   For i = 1 To 1000                             'weer 1000 loops
      Cells(1, i).EntireColumn.Select            'eerst die kolom selecteren
      Selection.ColumnWidth = 12                 'kolombreedte
   Next

   t3 = Timer
   For i = 1 To 1000                             'weer 1000 loops
      Cells(1, i).EntireColumn.ColumnWidth = 14  'kolombreedte
   Next


   MsgBox "zonder select : " & t1 - t0 & " sec" & vbLf & "met select : " & t2 - t1 & " sec" & vbLf & "met screenupdating en select : " & t3 - t2 & " sec" & vbLf & "met screenupdating zonder select : " & Timer - t3 & " sec"
End Sub

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #11 Gepost op: 24 juli 2020, 09:21:41 »
cow18,

bedankt voor de info :thumbsup:


   mvg,lco

Offline cow18

  • Ervaren lid
  • ***
  • Berichten: 340
  • Geslacht: Man
  • Oplossing.be
Re: Winnaarslijst aanpassen per trekking
« Reactie #12 Gepost op: 24 juli 2020, 12:24:43 »
verwijderen winnaars uit kolom B uit leden uit kolom A, via arrays, volledig in geheugen, niet via werkblad
Misschien wat te high-tech en not old schoolSub VerwijderenDubbels()
   Dim MijnLeden, MijnWinners

   With Sheets("blad1")
      .Range("A2:A1000").Name = "leden"          'gedefinieerde naam "leden" geven aan dit bereik
      MijnLeden = [Transpose(if(leden="","~",leden))]   'leden inlezen in array, blanco's invullen als "~"
      MijnWinners = Application.Transpose(.Range("B2:B1000"))   'winnaars inlezen in array

      For i = 1 To UBound(MijnWinners)           'alle winnaars aflopen
         If Len(MijnWinners(i)) > 0 Then         'staat er een naam
            r = Application.Match(MijnWinners(i), MijnLeden, 0)   'zoek naam bij leden
            If IsNumeric(r) Then MijnLeden(r) = "~"   'gevonden, dan lid vervangen door "~"
         End If
      Next

      MijnLeden = Filter(MijnLeden, "~", 0)      'alle "~" er uit filteren
      Range("leden").ClearContents               'bereik leegmaken
      If UBound(MijnLeden) <> -1 Then Range("leden").Resize(UBound(MijnLeden) + 1).Value = Application.Transpose(MijnLeden)   'resterende leden wegschrijven
   End With
End Sub

Offline lco

  • Oplosser
  • ****
  • Berichten: 759
  • Geslacht: Man
Re: Winnaarslijst aanpassen per trekking
« Reactie #13 Gepost op: 24 juli 2020, 13:05:07 »
cow18,

Bedankt voor de code , ga proberen via via ze te ontleden ::) ::) :-\ :-\



    mvg,lco

Offline cow18

  • Ervaren lid
  • ***
  • Berichten: 340
  • Geslacht: Man
  • Oplossing.be
Re: Winnaarslijst aanpassen per trekking
« Reactie #14 Gepost op: 25 juli 2020, 09:15:48 »
Een beetje moeilijk de eerste keer dat je het doet, maar je leert het meest door met F8 stap per stap door de macro te gaan en tegelijkertijd het venster "beeld>venster lokale variabelen" open te staan hebben en kijken welke waarden er daar aangenomen worden.

 


www.combell.com