Moderatori: Anthony47, Flash30005
6:12:4 >> RisultatoXX
5:12:5 >> Wintry Mix
Dim maX As Long, maY As Long, miX As Long, miY As Long
Sub ImportaPrevisioni()
Dim MIO As Worksheet, MODEL As Worksheet
Dim mySplit, I As Long, StarPo As Range
Dim Mark As String
'
Set MIO = ActiveSheet
Set MODEL = Workbooks("PREVISIONI_XA2.xlsm").Sheets("Modello3") 'Dichiara file/foglio da usare
MODEL.Parent.Activate 'Attiva file PREVISIONI...
MODEL.Select ' ...foglio Modello3
Mark = "Imp "
Range("C1") = "Called" 'Blocca Sub Maker da ChangeEvent
Debug.Print Mark & "Starts ....."
'
maX = 1580: miX = 1500
maY = 1330: miY = 1260
For I = 1 To 5 'Usa le 5 coppie X / Y
Debug.Print
Debug.Print Mark & "Fase 1; I = " & I, Timer
Application.EnableEvents = False
MODEL.Range("B3").Value = NormX(MIO.Range("B28").Cells(1, I).Value) ' X
Application.EnableEvents = True
MODEL.Range("B4").Value = NormY(MIO.Range("B27").Cells(1, I).Value) ' Y, start Change Event
DoEvents
If Len(MODEL.Range("C3") & MODEL.Range("C4")) = 0 Then 'Skip se "fuori scala"
Application.Run "'" & ActiveWorkbook.Name & "'!Maker" 'Esegui "Maker"
Debug.Print Mark & "Fase 2; I = " & I, Timer
'Preleva i risultati:
mySplit = Split(MODEL.Range("C10") & ">> ", ">> ", , vbTextCompare)
If MODEL.Range("B10") >= MODEL.Range("B11") Then '<<< Secco o Dubbio?
MIO.Range("B30").Cells(1, I) = mySplit(1) 'Valore "secco"
Else
MIO.Range("B30").Cells(1, I) = MODEL.Range("C10") 'Valore dubbio
End If
'report:
Debug.Print Mark & " X=" & Int(MIO.Range("B28").Cells(1, I).Value), _
"Y=" & Int(MIO.Range("B27").Cells(1, I).Value), "Esito: " & MODEL.Range("C10")
Debug.Print Mark, MIO.Range("B30").Cells(1, I).Address(0, 0), "Esito: " & MIO.Range("B30").Cells(1, I)
Else
MIO.Range("B30").Cells(1, I) = "Fuori Scala"
Debug.Print Mark & " X=" & Int(MIO.Range("B28").Cells(1, I).Value), _
"Y=" & Int(MIO.Range("B27").Cells(1, I).Value), "Esito: " & MIO.Range("B30").Cells(1, I)
Debug.Print Mark, MIO.Range("B30").Cells(1, I).Address(0, 0), "Fuori scala?"
End If
Next I 'ripeti next x-y
Range("C1").ClearContents 'Rimuovi flag "Called"
DoEvents
Beep
Debug.Print Mark & "Ends"
ThisWorkbook.Activate 'Attiva foglio master
End Sub
Function NormX(ByVal IPOX As Long) As Long
If IPOX > maX Then NormX = maX Else NormX = IPOX
If IPOX < miX Then NormX = miX Else NormX = IPOX
End Function
Function NormY(ByVal IPOY As Long) As Long
If IPOY > maY Then NormY = maY Else NormY = IPOY
If IPOY < miY Then NormY = miY Else NormY = IPOY
End Function
Anthony47 ha scritto:Dalle immagini allegate e dal codice della macro autoregistrata ho rilevato che il foglio contiene 5 coppie di valori, posizionati in B27:F28, i cui risultati vanno inseriti in B30:F30
Anthony47 ha scritto:PS: il tuo account principale dovrebbe essere disponibile
Dim maX As Long, maY As Long, miX As Long, miY As Long
Sub ImportaPrevisioni()
Dim MIO As Worksheet, MODEL As Worksheet
Dim mySplit, I As Long, StarPo As Range
Dim Mark As String, PuPa As String
'
Set MIO = ActiveSheet
Set MODEL = Workbooks("PREVISIONI_XA2.xlsm").Sheets("Modello3") 'Dichiara file/foglio da usare
Mark = "Imp "
If MIO.Name = "NowcastingGFS" Then
PuPa = "B27"
ElseIf MIO.Name = "OutlookGFS" Then
PuPa = "C28"
Else
MsgBox ("Foglio non selezionato, processo abortito")
Debug.Print Mark, "ERRATO Sheet", ActiveSheet.Name
Exit Sub
End If
MODEL.Parent.Activate 'Attiva file PREVISIONI...
MODEL.Select ' ...foglio Modello3
Range("C1") = "Called" 'Blocca Sub Maker da ChangeEvent
Debug.Print Mark & "Starts ....."
'
maX = 1580: miX = 1500
maY = 1330: miY = 1260
'
For I = 1 To 5 'Usa le 5 coppie X / Y
Debug.Print
Debug.Print Mark & "Fase 1; I = " & I, Timer
Application.EnableEvents = False
MODEL.Range("B3").Value = NormX(MIO.Range(PuPa).Cells(2, I).Value) ' X
Application.EnableEvents = True
MODEL.Range("B4").Value = NormY(MIO.Range(PuPa).Cells(1, I).Value) ' Y, start Change Event
DoEvents
If Len(MODEL.Range("C3") & MODEL.Range("C4")) = 0 Then 'Skip se "fuori scala"
Application.Run "'" & ActiveWorkbook.Name & "'!Maker" 'Esegui "Maker"
Debug.Print Mark & "Fase 2; I = " & I, Timer
'Preleva i risultati:
mySplit = Split(MODEL.Range("C10") & ">> ", ">> ", , vbTextCompare)
If MODEL.Range("B10") > MODEL.Range("B11") Then '<<< Secco o Dubbio?
MIO.Range(PuPa).Cells(4, I) = mySplit(1) 'Valore "secco"
Else
MIO.Range(PuPa).Cells(4, I) = MODEL.Range("C10") 'Valore dubbio
End If
'report:
Debug.Print Mark & " X=" & Int(MIO.Range(PuPa).Cells(2, I).Value), _
"Y=" & Int(MIO.Range(PuPa).Cells(1, I).Value), "Esito: " & MODEL.Range("C10")
Debug.Print Mark, MIO.Range(PuPa).Cells(4, I).Address(0, 0), "Esito: " & MIO.Range(PuPa).Cells(4, I)
Else
MIO.Range(PuPa).Cells(4, I) = "Fuori Scala"
Debug.Print Mark & " X=" & Int(MIO.Range(PuPa).Cells(2, I).Value), _
"Y=" & Int(MIO.Range(PuPa).Cells(1, I).Value), "Esito: " & MIO.Range(PuPa).Cells(4, I)
Debug.Print Mark, MIO.Range(PuPa).Cells(4, I).Address(0, 0), "Fuori scala?"
End If
Next I 'ripeti next x-y
'DoEvents
Range("C1").ClearContents 'Rimuovi flag "Called"
DoEvents: DoEvents
Beep
Debug.Print Mark & "Ends"
ThisWorkbook.Activate 'Attiva foglio master
End Sub
Function NormX(ByVal IPOX As Long) As Long
NormX = IPOX
If IPOX > maX Then NormX = maX
If IPOX < miX Then NormX = miX
End Function
Function NormY(ByVal IPOY As Long) As Long
NormY = IPOY
If IPOY > maY Then NormY = maY
If IPOY < miY Then NormY = miY
End Function
Torna a Applicazioni Office Windows
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
confrontare e evidenziare 2 fogli excel Autore: niccia |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 4 ospiti