gegevens verticaal zoeken en andere waarde weergeven

[bels]

Beste

In onderstaande tabel zien we type product en soort aflevering verdeeld over dagen.

TYPE Soort aflevering/dag
1/jan 2/jan 3/jan 4/jan 5/jan 6/jan
EB a k p k k a
EAB p a k p k a
ABC p p a k p s
ECB p k k a k a
BCA k k p k a a



Zou in een apart tabblad een weergave moeten krijgen van bv. alle K leveringen en nog een opsplitsing welk product.
Voor dit vb zou het dan moeten zijn :

1jan: BCA
2jan:EB, ECB BC
3jan:EAB, ECB
5 jan: EB, EAB en ECB,
onder 6jan :/

vermoed dat dit werkt via verticaal zoeken maar krijg het niet voor elkaar....


alvast bedankt.

Bels

 

[bels]

Bekijk bijlage helpmij.xls

mss makkelijker in excell map.

 

[oeldere]

Met een macro om de data in verticale vorm te krijgen.

Daarna met een draaitabel.

(je kunt ook gewoon filteren op kolom C => value).

Zie de bijlage.

Sub CONVERTROWSTOCOL_Oeldere_revisted_new()

Dim rsht1 As Long, rsht2 As Long, I As Long, col As Long, wsTest As Worksheet, mr As Worksheet, ms As Worksheet

'check if sheet "ouput" already exist

Const strSheetName As String = "Output"

Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

'set the data
                 

Set mr = Sheets("Blad1")                                  'this is the name of the source sheet
 
Set ms = Sheets("Output")                                       'this is the name of the destiny sheet

col = 2
'End set the data

    With ms
     .UsedRange.ClearContents
     .Range("A1:C1").Value = Array("Type", "Date", "value")
    End With
    
    rsht2 = ms.Range("A" & Rows.Count).End(xlUp).Row
    
    
    With mr
          rsht1 = .Range("A" & .Rows.Count).End(xlUp).Row
          For I = 5 To rsht1
                Do While .Cells(4, col).Value <> "" 'And .Cells(I, col).Value <> ""
                rsht2 = rsht2 + 1
               
                ms.Range("A" & rsht2).Value = .Range("A" & I).Value
                
                ms.Range("B" & rsht2).Value = .Cells(4, col).Value
                
                ms.Range("C" & rsht2).Value = .Cells(I, col).Value
         
                col = col + 1
            Loop
            col = 2
        Next
    End With
    
  With ms
  
  
  
  
    .Columns("A:Z").EntireColumn.AutoFit
    
    End With
    
End Sub

 

[bels]

Beste

alvast bedankt voor de snelle reactie.
Enkele puntjes zijn me nog niet duidelijk. stel ik wil extra types toevoegen, en extra data toevoegen in mijn oorsponkelijk tabblad...hoe kan ik er voor zorgen dat deze ook in de draaitabel terecht komen? en verwerkt worden?

mecikes
een beginneling....

 

[oeldere]

Dan run je opnieuw de macro.

De oude data worden gewist (gedeleted).

De nieuwe data worden dan aangemaakt.

Alle data staan dan in een verticale tabel (ook de nieuwe producten).

Je dient er wel voor te zorgen dat er geen gaten (lege kolommen) in de datums-kolommen staan.

Tevens dient in kolom A (Type) in alle rijen met data een typenummer vermeld te zijn.

De code maakt gebruik van het tellen van de aanwezige cellen in kolom A.

Daarna filter je op kolom C.

OF

Daarna maak je een nieuwe draaitabel.

 

[bels]

geen gegevens

Beste

de macro wordt uitgevoerd maar er komen geen gegevens mee ? Ik krijg in output blad enkel TYPE/DAT/VALUE maar geen gegevens en geen keuze menu's?

Wat voor ik verkeerd in?

thx.

 

[oeldere]

Set mr = Sheets("Blad1")

Wat is de naam van je werkblad (in mijn code is dat Blad 1)

Heeft je werkblad een andere naam, dan dient de code aangepast te worden.

Of je past je tabblad naam aan in Blad1 en kijkt of de gegevens dan wel goed meekomen.

 

[Leotaxi]

Dag Bels,

bij deze suggestie op blad 2, andere suggestie op blad 3
zeer korte uitleg voorzien op beide bladen


mvg

Leo