Excel VBA - variabele kolom

[Boerlo]

Ik zoek een manier om in een code een variabele kolom te benoemen, a.h.v. een ingegeven waarde waarmee gezocht kan worden in een tabel.
Omdat ik het moeilijk kan uitleggen, zie voorbeeld bijlage.

In het eerste werkblad "Gegevens" staan alle gegevens, in dit geval een voorbeeld met 5 klanten, die ieder 5 kolommen aan data bevatten.
Stel nu dat ik voor "klant1" de gegevens wil kopiëren naar het tweede werkblad "Rapport", dan moet de code voor klant1 het bereik B4:F73 selecteren.
Zou ik echter "klant2" kiezen, dan moet de code bereik G4:K73 selecteren.

Dat moet zoiets worden:

Sub klant1()
    Sheets("Gegevens").Select
    Range(Range("b4"), Range("a4").End(xlDown).End(xlDown).End(xlUp).Offset(0, 5)).Select
    Selection.Copy
    Sheets("Rapport").Select
    Range("b4").PasteSpecial Paste:=xlPasteValues
End Sub

Ik zoek nu een code om die kolom B variabel te maken, en op te zoeken aan de hand van een input. Dus dit:

Sub klant1()
    Sheets("Gegevens").Select
    Range(Range("??????"), Range("???????").End(xlDown).End(xlDown).End(xlUp).Offset(0, 5)).Select
    Selection.Copy
    Sheets("Rapport").Select
    Range("b4").PasteSpecial Paste:=xlPasteValues
End Sub

Bijvoorbeeld: bij klant2 moet de code zelf aan de hand van de input "2" gaan zoeken in het gegevensbestand en dan vaststellen dat het om kolom G t/m K gaat. Bij klant 3 moet ie zien dat het om kolom L t/m P gaat.

Normaalgesproken in Excel doe ik dit met INDEX en VERGELIJKEN, gewoon aan de hand van rij 2. Maar ik heb geen idee hoe dit in code moet.

Wellicht komt het niet duidelijk over, maar ik hoop dat iemand me verder kan helpen....

Alvast bedankt.

 

[cow18]

zo? Maar je kan eigenlijk hetzelfde doen met een nummer en dan toch op je 2e rij gaan zoeken

Sub Wie()
   mijnklant = Application.InputBox("wie moet je hebben", UCase("kopieren van een klant"), Type:=2)   'wie moet je hebben
   If Len(mijnklant) > 0 Then Kopieerklant mijnklant   'doorgeven aan andere macro
End Sub


Sub Kopieerklant(x)
   With Sheets("gegevens")
      k = Application.Match(x, .Rows(1), 0)      'zoek kolom waar je klant staat
      If IsNumeric(k) Then                       'klant gevonden
         r = .Range("A" & Rows.Count).End(xlUp).Row   'laatste rijnummer
         .Cells(4, k).Resize(r - 3, 5).Copy      'te kopieren
         Sheets("Rapport").Range("b4").PasteSpecial Paste:=xlPasteValues   'plakken
      Else
         MsgBox "foutje bedankt", vbCritical     'niet gevonden
      End If
   End With
End Sub

 

[LucHeyndrickx]

Gebruik volgende functie... die kan je dan gebruiken in een andere macro.
Die tweede macro staat er bij als test

Function CopyKlantgegevens(iKlantnummer As Integer)
    Dim lng As Long
    With Sheets("Gegevens")
        lng = .Range("a4").End(xlDown).Row - 3
        .Cells(4, 2).Offset(0, (iKlantnummer - 1) * 5).Resize(lng, 5).Copy
    End With
    Sheets("Rapport").Range("b4").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End Function


Sub test()
    CopyKlantgegevens 2
End Sub

het nummer achter de functie is de nummer van de klant.

 

[pasan]

Op het blad "Rapport" vul een naam in in cel "B1"
Voorkom samengevoegde cellen zoals op het blad "Gegevens".

 

[VenA]

Hoe kom je aan deze dataset? Lijkt mij een getransponeerde tabel waar je zelf nog wat in hebt lopen knutselen.

 

[cow18]

@Pasan, je maakt het jezelf toch een beetje moeilijk

Function klanttest(naam)
   bereik = Worksheets("Gegevens").Cells(4, 1).CurrentRegion
   kolomnummer = Application.Match(naam, Application.Index(bereik, 1, 0),0)
   If IsNumeric(kolomnummer) Then 
      etc

en mogelijks de events tijdelijk uitschakelen

 

[pasan]

Zo dan

Function klanttest(naam)
 Application.EnableEvents = False
  bereik = Worksheets("Gegevens").Cells(4, 1).CurrentRegion
  Cells(3, 2).CurrentRegion.ClearContents
 kolomnummer = Application.Match(naam, Application.Index(bereik, 1, 0), 0)

If Not IsError(kolomnummer) Then
 dd = Worksheets("Gegevens").Cells(3, kolomnummer).Resize(UBound(bereik), 5)
 aa = Worksheets("Gegevens").Cells(1).Resize(UBound(bereik))
 With Worksheets("Rapport")
 .Cells(3, 2).Resize(UBound(bereik), 5) = dd
 .Cells(1).Resize(UBound(bereik)) = aa
 End With
End If
Application.EnableEvents = True
End Function

 

[cow18]

er viel me anders nog iets grappigs/verontrustends op !
De kolom E (prijs) wordt gewoon afgerond zoveel cijfers na de komma.
Verander de corresponderende kolom in gegevens naar algemeen en laat de macro opnieuw lopen en je krijgt getallen binnen tot (niet geteld) 10 cijfers na de komma.

Dus op het ogenblik dat je iets van je werkblad naar een array leest, lees je niet het complete verhaal in, maar volgens de geldende opmaak van die cel.
Dit kan in bepaalde gevallen leuk zijn, maar in andere gevallen tot verkeerde resultaten leiden.
Dit is voor mij nu een nieuw gegeven, ik weet voorlopig niet of ik er blij mee ben.

 

[pasan]

maar in andere gevallen tot verkeerde resultaten leiden

kun je een voorbeeld schetsen?

 

[cow18]

neen, ik kan het niet meer, blijkbaar heb ik me verkeken op iets.

VOORAF : Ik had er problemen mee dat je iets inleest in een array "bereik", alleen maar om het aantal rijen te bepalen en er verder niets mee deed.
Daarna roep je nog 2 andere arrays "aa" en "dd" in het leven om de rest te doen.
Dus probeerde ik het, louter voor de fun, om alles vanuit die ene array "bereik" te doen.

Ik wist dat je met het inlezen van arrays in combinatie met de opmaak van datums in de problemen kon komen.
Gisterenavond dacht ik hetzelfde gezien te hebben voor de opmaak van getallen, maar ik kan dit nu niet herhalen. STOM. Dus vanaf hier gaat het enkele over datums.

Refererend naar hierboven moest ik wel in de fout gaan met de datums, zolang ze in "europees" formaat (dd-mm-jjjj) stonden.
De groene datums heb ik gewone getallen gemaakt en daar zullen dus nooit problemen mee voorkomen.

Dus nu de andere, niet groene, datums !
Als je vanuit de grote array "bereik" (73*26) die ene kolom datums wegschrijft, dan ga je met de europese datums (oranje cellen) in de fout.
Als je vanuit een kleine array (73*1) diezelfde kolom datums wegschrijft, dan maakt het niet uit.
Als je de arrays zelf checkt, dan is het in beide gevallen een "variant/date" maar in de kleine arrays blijven ze toch blijkbaar "europees" !
Daar zakt je broek toch van af !!!
Wist jij dit of was er een portie geluk mee gemoeid ?

Apart daarvan, als TS plots rij 2 of 3 leegmaakt, dan ga je door die veranderde layout wel eventjes in de fout door die currentregion.

 

[pasan]

Beide opties gebruiken de .Resize() dus voor beiden geldt dezelfde vaste logica t.a.v aantal kolommen per naam.
Jou datums verhaal moet ik ook eerst even bekijken kom er op terug....

Europees of niet, een datum is een getal, toch? En of je dat #getal# in een Array stopt maakt in eerste instantie niks uit, eventuele conversie methoden buiten beschouwing gelaten.

Het enigste verschil wat ik kan ontdekken is dat "cc" er tekst waarden van maakt en ik neem maar aan dat dat door de application.Index komt, en ongestructureerd een tekst waarde omzetten naar een getal (lees datum) daar komen de verschillen van. Excel heeft dan een extra Format nodig lijkt mij.

   aa = Worksheets("Gegevens").Cells(1).Resize(UBound(bereik))   'datumkolom er alleen uit halen
   bb = Worksheets("Gegevens").Cells(4, 1).CurrentRegion.Resize(, 1)   'datumkolom er alleen uit halen
   cc = Application.Index(bereik, rijen, 1)

Bovenstaande uitleg is gebaseerd op persoonlijk inzicht en niet op gedegen ervaring. Mocht iemand aanvullende uitleg / info hebben ...... leef je uit

 

[Jack Nouws]

Of zo, met combobox

 

[cow18]

ik bevestig je vaststelling,
Bereik is een array(1 to 73,1 to 26) met in de 1e kolom de datums als "variant/date"
Na die application.index krijg je cc(1 to 71,1 to 1) met daarin de datums een "variant/string".

Lees je die rechtstreeks in, zoals in bb dan zijn de datums analoog aan het verhaal van "bereik" van het type "variant/date".

Van vroeger wist ik dat je datums best naar getallen omzet (verander numberformat naar general) voor inlezen en daarna terugzetten naar de oorspronkelijke opmaak om dat soort grapjes te vermijden.
Blijkbaar is dat niet van belang zolang je de index niet gebruikt.
Weer iets geleerd.

 

[HSV]

Dat het een USA datumformaat wordt in een array heeft ook betrekking op:

Application.transpose(a) → zo inlezen: a(i,1) = clng(cdate(sv(i,1)) of format(sv(i,1),"mm/dd/yyyy")

En dat gebeurd vaker dan het 1 op 1 wegschrijven van een array (inlezen in een array en de array terug schrijven).

 

[cow18]

Jack's benadering is alleszins compact, rechttoe rechtaan, alleen misschien een pastespecial values ipv de gewone paste, dat dacht ik op zijn minst aan de hand van de code van TS.
Zowel Jack's als Luc's oplossing zijn dan wel iets te rudimentair voor het bepalen van het juiste kolomnummer.

ivm mijn probleem om alles vanuit die Pasan's ene array te doen, het gaat goed, zolang je een index gebruikt op delen van de array die geen datumformaten of valutaformaten bevatten. (had ik in #8 al opgemerkt, maar even later kon ik het niet meer herhalen), index kan dus gevaarlijke en onverwachtte resultaten opleveren als de opmaak afwijkt.
Dus in dit geval, de eerste kolom kan je gewoon rechtstreeks vanuit die array schrijven, zonder index. (en maakte geen deel uit van de vraag van TS)
De gewenste kolommen per klant bevatten wel financiële formaten, die worden door die index ook vertaald naar string en daarna als tekst neergezet, dus fout.
Het geheel is wel een stuk omslachtiger maar wel een leuke doch foute ervaring achteraf voor mij en zeker te hoog gegrepen voor TS.

Function klanttest(naam)
   bereik = Worksheets("Gegevens").Cells(4, 1).CurrentRegion   'inlezen naar array zoals je het ook deed
   kolomnummer = Application.Match(naam, Application.Index(bereik, 1, 0), 0)   'kolomnummer bepalen

   Application.EnableEvents = False
   Cells(3, 2).CurrentRegion.ClearContents       'inhoud wissen
   If IsNumeric(kolomnummer) Then                'klant gevonden
      Names.Add "kolomnummer", kolomnummer       'in gedefinieerde naam
      kolommen = [transpose( row(1:5)+kolomnummer-1)]   'in array bepalen welke kolommen er meegenomen moeten worden
      Names.Add "mijnrijen", UBound(bereik)      'in gedefinieerde naam de laatste rij
      rijen = [row(offset(a1,,,mijnrijen-2,))+2]   'in array bepalen welke rijen er meegenomen moeten worden

      With Worksheets("Rapport")
         .Cells(3, 2).Resize(UBound(bereik) - 2, 5) = Application.Index(bereik, rijen, kolommen)   'je data schrijven rechtstreeks uit de grote array, ok als daarin geen datums of financiele formaten staan
         .Cells(1, 1).Resize(UBound(bereik)) = bereik   'je datums eveneens schrijven rechtstreeks uit grote array = ok, zolang alles in de 1e rij of 1e kolom zou staan.
      End With
   End If
   Application.EnableEvents = True
End Function

 

[Boerlo]

Allen hartelijk dank voor de interessante uiteenzetting, heel leerzaam, soms te hoog gegrepen voor mij, maar ik ga ermee aan de slag. Leerzaam, beslist ook voor andere gebruikers. Dank.

 

[JEC.]

Deze achter je blad "Rapport". Na het veranderen van je klant in cel B1 wordt hij getriggerd.

Private Sub Worksheet_Change(ByVal Target As Range)
With Sheets("Gegevens")
 If Target.Address(0, 0) = "B1" Then
   jv = .Cells(1).CurrentRegion
   c00 = Application.Match(Target, Application.Index(jv, 1, 0), 0)
     If IsNumeric(c00) Then
      Range("B4", Cells(4, 6).Resize(UBound(jv) - 3)) = .Cells(4, c00).Resize(UBound(jv) - 3, 5).Value
      Range("A4", Cells(4, 1).Resize(UBound(jv) - 3)) = .Cells(4, 1).Resize(UBound(jv) - 3).Value
    End If
 End If
End With
End Sub

 

[pixcel]

@cow: Bart, de oorzaak is het inlezen van Currentregion. De default eigenschap van Range is Value, dus je leest Currentregion.Value. En dan doet Excel by design precies wat je hier beschrijft en als probleem ervaart, namelijk het converteren van cellen die zijn opgemaakt als Valuta en Datum in Excel naar Currency en Date in VBA (en vba.currency heeft maar 4 cijfers achter de komma).
Als je geen conversie wilt maar de onderliggende double waarden wilt lezen moet je Currentregion.Value2 gebruiken. Is nog een fors stuk sneller ook.
Het is good practice om default properties niet weg te laten.

Overigens, iets meer on topic: de vraag van ts is ook met power query op te lossen.

 

[cow18]

Als je geen conversie wilt maar de onderliggende double waarden wilt lezen moet je Currentregion.Value2 gebruiken. Is nog een fors stuk sneller ook.

Laat me opmerken dat deze tip me verraste, die ".value" zet ik normaal default er achter, maar tja, dat zal slordigheid geweest zijn, maar die value2, dat is hem !
Fors stuk sneller ? Sneller, ja, dan moet hij geen converties maken, maar fors ???
Dus, toch even gecheckt in een loop 1.000 keer en inderdaad, 30% sneller !!!
:thumb::thumb::thumb: