Aanpassen bestaande macro

Status
Niet open voor verdere reacties.

weewee

Gebruiker
Lid geworden
30 sep 2012
Berichten
31
Aanpassen van de macro
Is het ook mogelijk om de VBA zo aan te passen, dat er van klaverjasinvulblad de kolommen J en K gekopieerd worden met zoeken en vergelijken op naam naar weekstand. Dan krijg je standen en doormarsen naast elkaar met eventueel boven beide kolommen de datum van de speeldag. Graag zoeken op naam, omdat er mensen komen te opzeggen of ovelijden, dus deze cellen blijven leeg.
In tapblad einstand worden J en K wel opgeteld met 3D formule maar ik met nu iedere speel avond de leden die wegvallen apart er uit halen.
Ik ben al aan het zoeken geweest op internet hoe het zo moeten, maar ik heb totaal geen kennis van VBA en te oud om het in mijn pensioen jaren nog te leren.

Alvast bedank.

m.vr.gr. Willem Witwerts
 

Bijlagen

  • Klaverjas programma 01-12-2017.xlsm
    413,7 KB · Weergaven: 45
  • Macro kaarten.docx
    12,2 KB · Weergaven: 45
Laatst bewerkt:
Ik heb er iets van gemaakt Willem.

Laat de code 'hsv' lopen en zie het resultaat in werkblad 'Weekstand' die ik iets aangepast heb.
Ik ben van de namen in kolom C van beide werkbladen uitgegaan.
 

Bijlagen

  • Klaverjas programma 01-12-2017.xlsb
    266,2 KB · Weergaven: 32
Laatst bewerkt:
Hoi Harry

Ik heb je macro uitgeprobeerd en het werk zoals ik graag zou willen.
Ga nu verder met het programma aan het werk.
Als ik nog vragen heb dan stel ik die wel weer.
Hartelijk bedankt voor het zo snel beantwoorden en een oplossing geven.

m.vr.gr. Willem
 
Hallo Willem,

Misschien moet je de namen uit kolom F nemen, doordat kolom C door je formule wijzigt in tabblad 'weekstand'.
Code wordt dan:
Code:
Sub hsv()
Dim sv, sq, i As Long, ii As Long
With Sheets("klaverjasinvulblad")
sv = .Cells(1).CurrentRegion
sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 2)
sq(1, UBound(sq, 2) - 1) = Format(.Range("Z1"), "dd-mm")
sq(1, UBound(sq, 2)) = Format(.Range("Z1"), "dd-mm")
For i = 7 To UBound(sv)
 For ii = 2 To UBound(sq)
[COLOR=#0000ff]      If sv(i, 3) = sq(ii, 6) Then[/COLOR]
          sq(ii, UBound(sq, 2) - 1) = sv(i, 10)
          sq(ii, UBound(sq, 2)) = sv(i, 11)
          Exit For
      End If
  Next ii
 Next i
Sheets("weekstand").Cells(1, UBound(sq, 2) - 1).Resize(UBound(sq), 2) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 1, UBound(sq, 2)))
End With
End Sub
 
Hoi Harrij,

De macro werk zoals ik het graag zou willen hebben.
Maar ik heb toch nog een paar vragen.
Zou je mij willen aangeven hoe ik de volgende punten aan kan passen.
Ik weet nu hoe het zoeken op de naam in kolom C verplaatsen kan worden naar F.
Bijvoorbeeld het zoeken op naam in kolom F , hoe kan ik de kolom letter instellen waar de eerste rijen gegevens gekopieerd moeten worden.
En is het ook mogelijk om de rij in de stellen bij voorbeeld rij 4 waarin de datum komt en de rest er onder.

Nogmaals hartelijk bedank.

Willem
 
Hoi Willem,

Code:
Sheets("weekstand").Cells([COLOR=#ff0000]4[/COLOR], [COLOR=#0000ff]UBound(sq, 2) - 1[/COLOR]).Resize(UBound(sq), 2) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 1, UBound(sq, 2)))

De rode 4 geeft het rijnummer weer, en het blauwe geeft de kolomaanduiding.
In het geval van de kolom is dit gebaseerd op de laatste kolom - 1 van de array van tabblad 'weekstand' voordat het in zicht komt.
De nieuwe gegevens komen steeds achter van wat in zicht is.
 
Laatst bewerkt:
Dit Willem?
Code:
Sub hsv()
Dim sv, sq, i As Long, ii As Long
With Sheets("klaverjasinvulblad")
sv = .Cells(1).CurrentRegion
sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 3)
sq(1, UBound(sq, 2) - 2) = Format(.Range("Z1"), "mm-dd-yyyy")
sq(1, UBound(sq, 2) - 1) = Format(.Range("Z1"), "mm-dd-yyyy") 'of sq(1, UBound(sq, 2) - 2) 
sq(1, UBound(sq, 2)) = Format(.Range("Z1"), "mm-dd-yyyy")      'of sq(1, UBound(sq, 2) - 2) 
For i = 7 To UBound(sv)
 For ii = 2 To UBound(sq)
      If sv(i, 3) = sq(ii, 1) Then
          sq(ii, UBound(sq, 2) - 2) = sv(i, 13)
          sq(ii, UBound(sq, 2) - 1) = sv(i, 14)
          sq(ii, UBound(sq, 2)) = sv(i, 15)
          Exit For
      End If
  Next ii
 Next i
Sheets("weekstand").Cells(1, UBound(sq, 2) - 1).Resize(UBound(sq), 3) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 2, UBound(sq, 2) - 1, UBound(sq, 2)))
End With
End Sub
 
Aanpassem macro

Harrij

Ik krijg op deze regel een foutmelding

sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 3)


nogmaals hartelijk dank

Willem
 
Niet in het laatste bestand wat je plaatste.
Zit je aan het eind van het werkblad met je kolommen?

Wat voor foutmelding?

In elk geval moet je deze regel nog even aanpassen.
Code:
Sheets("weekstand").Cells(1, UBound(sq, 2) - [COLOR=#ff0000]2[/COLOR]).Resize(UBound(sq), 3) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 2, UBound(sq, 2) - 1, UBound(sq, 2)))
 
aanpassen macro

Hoi Harrij,

De code regel wordt geel.
Verder komt er geen fout melding.
Ook je nieuwe regel geeft deze gele regel.

Willem
 
Plaats het bestand eens met de code als je wilt.
 
Harrij,

sorrij niet goed gekeken. Code 13 wordt aangegeven.

Sub hsv()
Dim sv, sq, i As Long, ii As Long
With Sheets("klaverjasinvulblad")
sv = .Cells(1).CurrentRegion
Sheets("weekstand").Cells(1, UBound(sq, 2) - 2).Resize(UBound(sq), 3) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 2, UBound(sq, 2) - 1, UBound(sq, 2)))
'sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 3)
sq(1, UBound(sq, 2) - 2) = Format(.Range("Z1"), "mm-dd-yyyy")
sq(1, UBound(sq, 2) - 1) = Format(.Range("Z1"), "mm-dd-yyyy") 'of sq(1, UBound(sq, 2) - 2)
sq(1, UBound(sq, 2)) = Format(.Range("Z1"), "mm-dd-yyyy") 'of sq(1, UBound(sq, 2) - 2)
For i = 7 To UBound(sv)
For ii = 2 To UBound(sq)
If sv(i, 3) = sq(ii, 1) Then
sq(ii, UBound(sq, 2) - 2) = sv(i, 13)
sq(ii, UBound(sq, 2) - 1) = sv(i, 14)
sq(ii, UBound(sq, 2)) = sv(i, 15)
Exit For
End If
Next ii
Next i
Sheets("weekstand").Cells(1, UBound(sq, 2) - 1).Resize(UBound(sq), 3) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 2, UBound(sq, 2) - 1, UBound(sq, 2)))
End With
End Sub

Willem
 
Haal die code maar gauw weer weg.
De boel staat nu door elkaar.
 
Harrij

Sub hsv()
Dim sv, sq, i As Long, ii As Long
With Sheets("klaverjasinvulblad")
sv = .Cells(1).CurrentRegion
sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 3)
sq(1, UBound(sq, 2) - 2) = Format(.Range("Z1"), "mm-dd-yyyy")
sq(1, UBound(sq, 2) - 1) = Format(.Range("Z1"), "mm-dd-yyyy") 'of sq(1, UBound(sq, 2) - 2)
sq(1, UBound(sq, 2)) = Format(.Range("Z1"), "mm-dd-yyyy") 'of sq(1, UBound(sq, 2) - 2)
For i = 7 To UBound(sv)
For ii = 2 To UBound(sq)
If sv(i, 3) = sq(ii, 1) Then
sq(ii, UBound(sq, 2) - 2) = sv(i, 13)
sq(ii, UBound(sq, 2) - 1) = sv(i, 14)
sq(ii, UBound(sq, 2)) = sv(i, 15)
Exit For
End If
Next ii
Next i
Sheets("weekstand").Cells(1, UBound(sq, 2) - 1).Resize(UBound(sq), 3) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 2, UBound(sq, 2) - 1, UBound(sq, 2)))
End With
End Sub

Met deze code krijg ik fout melding 1004

Willem
 
Plaats het bestand eens, en plaats codes graag tussen codetags met een hekje (#).
 
macro aanpassen

Hoi Harrij,

Sorry; ik kon niet eerder reageren.
Hierbij nog een keer de aangepaste programma en de werkende macro uit de oude programma.
Ik krijg code 1004 in de onderstaande code regel.

HTML:
sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 2)


Code:
Sub hsv()
Dim sv, sq, i As Long, ii As Long
With Sheets("klaverjasinvulblad")
sv = .Cells(1).CurrentRegion
sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 2)
sq(1, UBound(sq, 2) - 1) = Format(.Range("Z1"), "dd-mm")
sq(1, UBound(sq, 2)) = Format(.Range("Z1"), "dd-mm")
For i = 7 To UBound(sv)
 For ii = 2 To UBound(sq)
   If sv(i, 3) = sq(ii, 3) Then
      sq(ii, UBound(sq, 2) - 1) = sv(i, 10)
      sq(ii, UBound(sq, 2)) = sv(i, 11)
     Exit For
   End If
 Next ii
 Next i
Sheets("weekstand").Cells(1, UBound(sq, 2) - 1).Resize(UBound(sq), 2) = Application.Index(sq, [row(1:103)], Array(UBound(sq, 2) - 1, UBound(sq, 2)))
End With
End Sub

Ik verwacht dat je hier voldoende aan hebt.

m.vr. gr.

Willem
 

Bijlagen

  • KlaverjasVierAzen seizoen 2017-2018 af nieuw 12-1-2018 Leegwww.xlsm
    537,4 KB · Weergaven: 43
In de melding staat nog wat meer. Je hebt het blad beveiligd en dat moet je of niet doen of ervoor zorgen dat de beveiliging er afgehaald en weer opgezet wordt.
 
Laatst bewerkt:
Code:
sq = Sheets("weekstand").Cells(1).CurrentRegion.Resize(, Sheets("weekstand").Cells(1).CurrentRegion.Columns.Count + 3)

Harrij;

Deze code regels wordt nog geel en geeft foutmelding 1004

Willem
 
Waar reageer je op? Heb je geen y op je toetsenbord zitten?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan