extract top 100 values from multiple columns

[Dr.Excel]

salutare,
Va supun atentiei o problema, poate reuseste cineva o solutie cu sau fara macro, important este sa fie cat mai usor si rapid pentru end user.
Se doreste extragerea unui centralizator din tabelul atasat, cu top 100 repere(si valoarea) cu cele mai mari vanzari/CA pentru fiecare quarter(Q1,Q2,Q3,Q4).
In centralizatorul final sa apara: Reperul, Valoarea si Quarterul. Apoi se doreste si suma acestor topuri pentru fiecare quarter in parte, dar ma gandesc ca se poate face ca operatie aditionala in tabelul de output prin pivot table sau subtotal
Tx

[IPP]

Buna ziua

Atasat aveti spre testare o propunere folosind macro

Premise: -informatia sursa se afla in foaia CA si are aceeasi structura ca cea din fisierul dvs. exemplu; denumirea foii si cea numita Result nu se vor redenumi
la fel si pentru denumirile din N3:Q3

Am folosit urmatoarele coduri:

Cod: Selectaţi tot

Sub TopSales()

'IPP - 23.03.2018

Dim aRow As Long
Dim lRow As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'sterge info veche
Sheets("Result").Range("A1").CurrentRegion.Offset(1, 0).ClearContents

Sheets("CA").Select

lRow = Range("A65536").End(xlUp).Row

Range("N4").Select
Do Until IsEmpty(Cells(ActiveCell.Row, 1))
 aRow = ActiveCell.Row
 ActiveCell.Value = Application.WorksheetFunction.Sum(Range(Cells(aRow, 2), Cells(aRow, 4)))
 ActiveCell.Offset(0, 1).Value = Application.WorksheetFunction.Sum(Range(Cells(aRow, 5), Cells(aRow, 7)))
 ActiveCell.Offset(0, 2).Value = Application.WorksheetFunction.Sum(Range(Cells(aRow, 8), Cells(aRow, 10)))
 ActiveCell.Offset(0, 3).Value = Application.WorksheetFunction.Sum(Range(Cells(aRow, 11), Cells(aRow, 13)))

ActiveCell.Offset(1, 0).Select
Loop

Range("N4:N" & lRow).Select
 Call ExtractInfo
Selection.Offset(0, 1).Select
 Call ExtractInfo
Selection.Offset(0, 1).Select
 Call ExtractInfo
Selection.Offset(0, 1).Select
 Call ExtractInfo
 
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

Cod: Selectaţi tot

Sub ExtractInfo()

For Each c In Selection
 If Application.WorksheetFunction.Rank(c, Selection, 0) <= 100 Then
  With Sheets("Result").Range("A65536").End(xlUp).Offset(1, 0)
  .Value = Cells(c.Row, 1) 'nume item
  .Offset(0, 1).Value = Cells(Selection.Row - 1, Selection.Column).Value 'T Q
  .Offset(0, 2).Value = c.Value 'valoare
  
  End With
 End If

Next c

End Sub

Acestea:
-sterg eventuala informatie veche din foaia result
-insumeaza valorile la nivel de quarter si item
-fac o verificare (la nivel de totaluri fiecare quarter) pe baza functiei Rank si, daca se incadreaza in top 100, scriu informatia aferenta in foaia result

Pe baza informatiei extrase se pot face prelucrari ulterioare de alta natura.

Pentru testare: deschideti fisierul atasat, activati macro/continutul si rulati macro
Nota: estimativ, pe calculatorul meu timpul de executie a fost de cca. 45 secunde

IP

[annaK]

Multumesc pentru solutia rapida.

[annaK]

Dupa ce-am rulat macro am obtinut 2 tabele Result pt CA si vanzari.

In continuare am nevoie ca rezultatul final sa fie un mix dintre cele 2 tabele de result, care sa contina Reperul/Vanzarile/CA/Quarter, pentru a alege mai apoi cel mai bun mixt de CA & vanzari pentru fiecare quarter.

Ma ajutati cu o solutie?

Thanks

Ana

[IPP]

Buna ziua

Ar trebui sa incercati sa explicati ceea ce doriti pe un exemplu (fisier exemplu) mai concret, chiar daca in prima faza rezultatul asteptat il obtineti mai mult sau mai putin "manual". Eu unul nu am inteles ce doriti, poate reuseste altcineva

IP

[annaK]

Am atasta fisierul exemplu pentru ceea ce am nevoie sa fie rezultatul final, datele din foile top CA si top vanzari vor fi centralizate in foaia result cu acea structura.
Sper ca este mai clar

[TudyBTH]

Buna,

Formatul datelor sursa ma face sa cred ca acestea sunt preluate din alt fisier sau dintr-un raport.
Daca presupunerea mea este corecta, cred ca cel mai bine ar fi sa se faca o depivotare a datelor.
Aceasta operatie deschide posibilitaea de a folosi in continuare metodele native Excel pentru obtinerea topului sau a altor situatii.
Pentru depivotare se poate folosi un Query sau, daca versiunea nu permite aceasta aveti mai jos un cod care realizeaza depivotarea.

Cod: Selectaţi tot

Option Explicit

Sub UnpivotAll()
    Dim rData As Range
    Dim ws As Worksheet, wsRaw As Worksheet
    
    Set ws = ThisWorkbook.Sheets("Vanzari")
    Set wsRaw = ThisWorkbook.Sheets("vanzari_Raw")
    UnpivotData ws, wsRaw
    
    Set ws = ThisWorkbook.Sheets("CA")
    Set wsRaw = ThisWorkbook.Sheets("CA_Raw")
    UnpivotData ws, wsRaw
    
End Sub

Private Sub UnpivotData(ByRef ws As Worksheet, ByRef wsRaw As Worksheet)
    Dim y As Integer, m As Integer
    Dim ref As Variant
    Dim i As Long, j As Long
    Dim firstRow As Long, lastRow As Long
    
    '==================================
    y = ws.Range("B1").Value
    firstRow = 4
    '==================================
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row - 1
    If lastRow < firstRow Then Exit Sub
    wsRaw.Cells.ClearContents
    wsRaw.Range("A1:D1").Value = Array("Referance", "Year", "Month", "Value"): j = 1
    Application.ScreenUpdating = False
    For i = firstRow To lastRow
        ref = ws.Cells(i, "A").Value
        For m = 1 To 12
            j = j + 1
            wsRaw.Cells(j, 1).Value = ref
            wsRaw.Cells(j, 2).Value = y
            wsRaw.Cells(j, 3).Value = m
            wsRaw.Cells(j, 4).Value = ws.Cells(i, m + 1).Value
        Next m
    Next i
    Application.ScreenUpdating = True
    
End Sub

[IPP]

@annaK

Nu stiu pentru altii, dar pentru mine un simplu cap de tabel (bazat pe o structura si cerinte pe care le vad prima data in viata mea si nu au legatura cu ce lucrez de obicei), fara niste informatii minime (2-3 randuri completate) nu imi spune cum ar trebui sa arate rezultatul final. Si nici de ce