Buon giorno.
Vorrei sapere se qualcuno è a conoscenza di una macro per excell, in grado di effettuare in automatico una analisi ABC su una serie di dati.
Vi ringrazio per l'attenzione,
saluti
Moderatori: Anthony47, Flash30005
=SE(A5<>"";SE(F5<$I$1; "A";SE(F5>$J$1; "C"; "B" ));"")
=SOMMA(D1:D1000)
=D5/$E$1
ricky53 ha scritto:Ciao,
forse mi sono perso qualcosa ... con l'esempio non hai risolto essendo arrivato al risultato atteso?
Perchè vuoi fare le stesse operazioni con una macro
Sub AnalisiABC()
Worksheets("Foglio1").Select
UR = Range("A" & Rows.Count).End(xlUp).Row
Mtot = 0
For RR = 5 To UR
Range("D" & RR).Value = Range("B" & RR).Value * Range("C" & RR).Value
Range("D" & RR).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
Mtot = Mtot + Range("D" & RR).Value
Next RR
Range("D" & UR + 1).Value = Mtot
Range("D" & UR + 1).NumberFormat = "_($* #,##0.00_);_($* (#,##0.00);_($* ""-""??_);_(@_)"
For RR = 5 To UR
Range("E" & RR).Value = Range("D" & RR).Value / Mtot
Range("E" & RR).NumberFormat = "0.00%"
Next RR
Range("A4:G" & UR).Select
Selection.Sort Key1:=Range("D5"), Order1:=xlDescending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("H23").Select
For RR = 5 To UR
If RR = 5 Then
MTF = Range("E" & RR).Value
Else
MTF = MTF + Range("E" & RR).Value
End If
Range("F" & RR).Value = MTF
Range("F" & RR).NumberFormat = "0.00%"
Number = Range("F" & RR).Value
Select Case Number
Case 0 To 0.8
Range("G" & RR).Value = "A"
Case 0.8001 To 0.95
Range("G" & RR).Value = "B"
Case Else
Range("G" & RR).Value = "C"
End Select
Next RR
End Sub
Bravo! Sappi che ancora oggi la meta' del mio codice nasce da una macro registrata.Ho apportato le modifiche dettate da Anthony47 ed ho creato la mia prima macro!
In genere si tratta di codice non ottimizzato; copialo tutto, incollalo nel prossimo messaggio e a scopo didattico lo comprimeremo per renderlo meno superfluo.
Sub ABC_Analysis()
'
' ABC_Analysis Macro
' Esegue l'analisi Abc
'
'
Application.Goto Reference:="R5C1:R1004C5"
ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add Key:=Range( _
"E5:E1004"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Foglio1").Sort
.SetRange Range("A4:E1004")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWindow.SmallScroll Down:=-15
Range("A1").Select
End Sub
Sub ABC_Analysis()
'
' ABC_Analysis Macro
' Esegue l'analisi Abc
Application.Goto Reference:="R5C1:R1004C5" '<<< Inutile
ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add Key:=Range( _
"E5:E1004"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Foglio1").Sort
.SetRange Range("A4:E1004")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin '<<< E' il valore di dafault
.Apply
End With
ActiveWindow.SmallScroll Down:=-15 '<<< inutile
Range("A1").Select
End Sub
Anthony47 ha scritto:
Per ogni esigenza sai dove chiedere.
Ciao
Torna a Applicazioni Office Windows
Macro che scatta quando cambia dato in un altro file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 14 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Macro che ricerca combinazioni che danno un valore Autore: kar64 |
Forum: Applicazioni Office Windows Risposte: 10 |
Macro che indica la riga prima della cella attiva Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 19 |
Visitano il forum: Nessuno e 79 ospiti