| | Post: 3.078 | Registrato il: 03/04/2013
| Utente Master | Excel 2000 - 2013 | | OFFLINE | |
|
12/07/2018 23:01 | |
Buona sera, Likan85;
premesso che andrebbero rivisti i parametri inseriti nelle varie Commesse, potresti provare questo Codice VBA:
Option Explicit
Sub Planing_Impegni()
On Error GoTo 10
Application.ScreenUpdating = False
Dim Ncl As Long, Cmm As Long, DtX As Long
Dim k As Long, x As Long, y As Long, z As Long
Dim Rtd As Byte, CMP As Byte
Dim PDt As Integer, DtF As Integer
Dim DCM As Date, ggCM As Byte
Dim DAS As Date, ggAs As Byte
Dim DSA As Date, ggSa As Byte
Sheets("Commessa").Select
With Worksheets("Planing")
Ncl = Cells(2, Columns.Count).End(xlToLeft).Column
Cmm = .Range("A" & .Rows.Count).End(xlUp).Row
DtX = .Cells(2, .Columns.Count).End(xlToLeft).Column
Range(.Cells(2, 8), .Cells(Cmm, DtX)).Interior.Pattern = xlNone
For k = 3 To Cmm
Cells(3, 1).Value = .Cells(k, 1).Value
For PDt = 10 To Ncl
If Cells(4, PDt).Value <> "" Then Exit For
Next PDt
For DtF = Ncl To 10 Step -1
If Cells(4, DtF).Value <> "" Then Exit For
Next DtF
DCM = Cells(2, PDt).Value
ggCM = DtF - PDt
For PDt = 10 To Ncl
If Cells(5, PDt).Value <> "" Then Exit For
Next PDt
For DtF = Ncl To 10 Step -1
If Cells(5, DtF).Value <> "" Then Exit For
Next DtF
DAS = Cells(2, PDt).Value
ggAs = DtF - PDt
For PDt = 10 To Ncl
If Cells(6, PDt).Value <> "" Then Exit For
Next PDt
For DtF = Ncl To 10 Step -1
If Cells(6, DtF).Value <> "" Then Exit For
Next DtF
DSA = Cells(2, PDt).Value
ggSa = DtF - PDt
Rtd = Cells(3, 7).Value
For x = 2 To Cmm
If .Cells(x, 1).Value = Cells(3, 1).Value Then Exit For
Next x
For y = 8 To DtX
If .Cells(2, y).Value = Cells(3, 2).Value Then Exit For
Next y
For z = 8 To DtX
If .Cells(2, z).Value = Cells(3, 3).Value Then Exit For
Next z
Range(.Cells(k, y), .Cells(k, z)).Interior.ThemeColor = xlThemeColorAccent1
Range(.Cells(k, y), .Cells(k, z)).Interior.TintAndShade = 0.799981688894314
If Rtd <> 0 Then Range(.Cells(k, z + 1), .Cells(k, z + Rtd)).Interior.Color = 255
Range(.Cells(k, DCM - .Cells(2, 8).Value + 8), .Cells(k, DCM - .Cells(2, 8).Value + 8 + ggCM)).Interior.Color = 65535
Range(.Cells(k, DAS - .Cells(2, 8).Value + 8), .Cells(k, DAS - .Cells(2, 8).Value + 8 + ggAs)).Interior.Color = 15773696
Range(.Cells(k, DSA - .Cells(2, 8).Value + 8), .Cells(k, DSA - .Cells(2, 8).Value + 8 + ggSa)).Interior.Color = 5296274
Next k
Cells(3, 1).Value = .Cells(3, 1).Value
Cells(8, 10).Select
.Select
End With
Application.ScreenUpdating = True
Cells(3, 8).Select
End
10:
MsgBox "Dati incongruenti nella Commessa " & Cells(3, 1).Value & Chr(10) & "n.d.r Ritardo consegna minimo 8 gg."
Application.ScreenUpdating = True
Cells(8, 10).Select
End Sub
In allegato il File con il quale ho condotto i miei Test.
Nel Foglio di lavoro "Commessa" è possibile visualizzare il Lead Time della Commessa selezionata, tramite convalida dati, in Cella "A3".
Premendo il Pulsante "Planing" vengono gestiti graficamente i Lead Time di tutte le Commesse in portafoglio nel Foglio di lavoro "Planing".
Mi permetto di precisare che i Dati attribuiti alle varie Commesse non sono sempre congruenti; in particolare andranno rivisti i Dati attribuiti alla Commessa "C_18_001".
A disposizione.
Buona serata.
Giuseppe
Windows XP - Excel 2000
Windows 10 - Excel 2013 |