extract top 100 values from multiple columns

extract top 100 values from multiple columns

Mesajde Dr.Excel » Vin Mar 23, 2018 8:57 am

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
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Dr.Excel
MCT, MCITP
MOS Master Instructor
IT Learning
Avatar utilizator
Dr.Excel
Site Admin
Site Admin
 
Mesaje: 1918
Membru din: Sâm Ian 24, 2009 1:45 pm
Localitate: Bucharest

Re: extract top 100 values from multiple columns

Mesajde IPP » Vin Mar 23, 2018 9:58 am

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
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
IPP
Moderator
Moderator
 
Mesaje: 3744
Membru din: Mie Iul 29, 2009 7:26 am
Localitate: Cluj-Napoca

Re: extract top 100 values from multiple columns

Mesajde annaK » Vin Mar 23, 2018 10:26 am

Multumesc pentru solutia rapida. :)
annaK
 
Mesaje: 3
Membru din: Vin Mar 23, 2018 9:22 am

Re: extract top 100 values from multiple columns

Mesajde annaK » Vin Mar 23, 2018 11:06 am

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
annaK
 
Mesaje: 3
Membru din: Vin Mar 23, 2018 9:22 am

Re: extract top 100 values from multiple columns

Mesajde IPP » Vin Mar 23, 2018 11:11 am

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
IPP
Moderator
Moderator
 
Mesaje: 3744
Membru din: Mie Iul 29, 2009 7:26 am
Localitate: Cluj-Napoca

Re: extract top 100 values from multiple columns

Mesajde annaK » Vin Mar 23, 2018 11:29 am

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 :)
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
annaK
 
Mesaje: 3
Membru din: Vin Mar 23, 2018 9:22 am

Re: extract top 100 values from multiple columns

Mesajde TudyBTH » Vin Mar 23, 2018 11:35 am

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
Nu aveţi permisiunea de a vizualiza fişierele ataşate acestui mesaj.
Am invatat sa inotam in apa, ca pestii
Am invatat sa zburam in aer, ca pasarile
A ramas doar sa invatam sa traim pe Pamant, ca Oamenii.
TudyBTH
Moderator
Moderator
 
Mesaje: 877
Membru din: Joi Feb 11, 2016 2:12 pm
Localitate: Cluj Napoca

Re: extract top 100 values from multiple columns

Mesajde IPP » Vin Mar 23, 2018 11:57 am

@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
IPP
Moderator
Moderator
 
Mesaje: 3744
Membru din: Mie Iul 29, 2009 7:26 am
Localitate: Cluj-Napoca


Înapoi la Visual Basic for Application (VBA) cu Excel - Intrebari tehnice

Cine este conectat

Utilizatorii ce navighează pe acest forum: Niciun utilizator înregistrat şi 4 vizitatori