La consultazione del forum è libera per tutti.
Per poter porre un quesito è invece necessario essere un utente registrato (clicca qui se non lo sei).
Tutti gli utenti che richiedono un supporto, come da REGOLAMENTO, sono caldamente invitati ad allegare un file di esempio con l'indicazione di quello che si desidera ottenere.
Buongiorno,
ho notato che in alcune condizioni il calcolo è sbagliato, in allegato ci sono delle note con lo sfondo colorato che sono di esempio.
se volesi aggiungere delle colonne a sinistra e sopra i dati, come modifico il VBA per "spostare" il range di calcolo?
Grazie.
se volesi aggiungere delle colonne a sinistra e sopra i dati, come modifico il VBA per "spostare" il range di calcolo?
Prima di guardare il file.... hai almeno una base di VBA?
Senza quella è inutile andare avanti, devi essere un minimo in grado di poter modificare il codice all'esigenza (è per questo motivo che ti ho chiesto da subito se c'erano altre cose da fare oltre ad ottenere i risultati nelle colonne E e F).
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
ho notato che in alcune condizioni il calcolo è sbagliato, in allegato ci sono delle note con lo sfondo colorato che sono di esempio.
In effetti c'era qualcosa da correggere.
Sostituisci il codice direttamente con questo modificato:
Sub CheckOperators()
Dim LRow As Long
Dim ArrOrigin
Dim i As Long
Dim j As Long
Dim k As Double
Dim OrdDataOper
Dim AppSplit
Dim NrOrder As Variant
Dim Operators As String
Dim ActData As String
Dim StartHour As Double
Dim EndHour As Double
Dim AppArray()
LRow = Range("A" & Rows.Count).End(xlUp).Row
If LRow > 2 Then
Application.ScreenUpdating = False
ArrOrigin = Range("A3:C" & LRow)
ReDim AppArray(1 To UBound(ArrOrigin, 1), 1 To 2)
For i = 1 To UBound(ArrOrigin, 1)
OrdDataOper = Split(ArrOrigin(i, 1), "-")
NrOrder = OrdDataOper(0)
ActData = OrdDataOper(1)
Operators = OrdDataOper(2)
StartHour = ArrOrigin(i, 2)
EndHour = ArrOrigin(i, 3)
If i Mod 200 = 0 Then DoEvents
If i + 1 < UBound(ArrOrigin, 1) Then
For j = i + 1 To UBound(ArrOrigin, 1)
If Len(AppArray(j, 2)) = 0 Then
AppSplit = Split(ArrOrigin(j, 1), "-")
If AppSplit(0) = NrOrder Then
If (ArrOrigin(j, 2) <= StartHour And ArrOrigin(j, 3) >= StartHour _
And ArrOrigin(j, 3) <= EndHour) Then
AppArray(j, 2) = ArrOrigin(j, 3) - StartHour
ElseIf (ArrOrigin(j, 2) >= StartHour And ArrOrigin(j, 3) <= EndHour) Then
AppArray(j, 2) = ArrOrigin(j, 3) - ArrOrigin(j, 2)
ElseIf (ArrOrigin(j, 2) >= StartHour And ArrOrigin(j, 2) <= EndHour And ArrOrigin(j, 3) >= EndHour) Then
AppArray(j, 2) = EndHour - ArrOrigin(j, 2)
ElseIf (ArrOrigin(j, 2) <= StartHour And ArrOrigin(j, 3) >= EndHour) Then
AppArray(j, 2) = EndHour - StartHour
End If
End If
If Len(AppArray(j, 2)) > 0 Then
AppArray(j, 1) = Operators & "-" & AppSplit(2)
End If
End If
Next j
End If
Next i
ArrOrigin = AppArray
Range("E3").Resize(UBound(ArrOrigin, 1), 2).Value = ArrOrigin
Application.ScreenUpdating = True
MsgBox "Controllo eseguito.", vbInformation + vbOKOnly, "OPERAZIONE COMPLETATA"
End If
End Sub
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
se mi dicessero che conosco il VBA come una capra, mi farebbero un complimento.
Ricorda di segnare la discussione come RISOLTA, per altri problemi/modfiche apri un nuovo thread.
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
certamente, stamattina ho fatto altre prove e il file prodotto dà i risultati attesi.
Grazie.
sì può mettere la discussione risolta, ti ringrazio ancora per l'ottimo lavoro. Grazie.
sì può mettere la discussione risolta,
puoi farlo tu, in cima alla discussione (prima pagina - sopra il Topic, cioè il primo post) c'è il pulsante apposito:
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Buonasera, ho riaperto la discussione perchè si verifica un messaggio di errore al momento del lancio del VBA, la stranezza stà nel fatto che il programma ha funzionato ma ora compare un messaggio di errore che allego.
Grazie.
la stranezza stà nel fatto che il programma ha funzionato ma ora compare un messaggio di errore
come puoi bene immaginare, se il codice prima funzionava e adesso no vuol dire che è stato modificato qualcosa nella struttura del foglio.
Solo con le immagini si può fare ben poco, serve il file... potrei solo azzardare l'ipotesi che la lista contiene delle celle vuote in colonna A (o comunque non con la sintassi Ordine-Data-Operatore prevista nel codice) o in altre colonne controllate dal codice.
La cosa più "immediata" che si può fare è far proseguire il codice anche in caso di errore con:
On Error Resume Next 'codice... On Error GoTo 0
anche se non è certo l'approccio migliore!
L'intero codice diventerebbe:
Sub CheckOperators()
Dim LRow As Long
Dim ArrOrigin
Dim i As Long
Dim j As Long
Dim k As Double
Dim OrdDataOper
Dim AppSplit
Dim NrOrder As Variant
Dim Operators As String
Dim ActData As String
Dim StartHour As Double
Dim EndHour As Double
Dim AppArray()
LRow = Range("A" & Rows.Count).End(xlUp).Row
If LRow > 2 Then
On Error Resume Next
Application.ScreenUpdating = False
ArrOrigin = Range("A3:C" & LRow)
ReDim AppArray(1 To UBound(ArrOrigin, 1), 1 To 2)
For i = 1 To UBound(ArrOrigin, 1)
OrdDataOper = Split(ArrOrigin(i, 1), "-")
NrOrder = OrdDataOper(0)
ActData = OrdDataOper(1)
Operators = OrdDataOper(2)
StartHour = ArrOrigin(i, 2)
EndHour = ArrOrigin(i, 3)
If i Mod 200 = 0 Then DoEvents
If i + 1 < UBound(ArrOrigin, 1) Then
For j = i + 1 To UBound(ArrOrigin, 1)
If Len(AppArray(j, 2)) = 0 Then
AppSplit = Split(ArrOrigin(j, 1), "-")
If AppSplit(0) = NrOrder Then
If (ArrOrigin(j, 2) <= StartHour And ArrOrigin(j, 3) >= StartHour _
And ArrOrigin(j, 3) <= EndHour) Then
AppArray(j, 2) = ArrOrigin(j, 3) - StartHour
ElseIf (ArrOrigin(j, 2) >= StartHour And ArrOrigin(j, 3) <= EndHour) Then
AppArray(j, 2) = ArrOrigin(j, 3) - ArrOrigin(j, 2)
ElseIf (ArrOrigin(j, 2) >= StartHour And ArrOrigin(j, 2) <= EndHour And ArrOrigin(j, 3) >= EndHour) Then
AppArray(j, 2) = EndHour - ArrOrigin(j, 2)
ElseIf (ArrOrigin(j, 2) <= StartHour And ArrOrigin(j, 3) >= EndHour) Then
AppArray(j, 2) = EndHour - StartHour
End If
End If
If Len(AppArray(j, 2)) > 0 Then
AppArray(j, 1) = Operators & "-" & AppSplit(2)
End If
End If
Next j
End If
Next i
ArrOrigin = AppArray
Range("E3").Resize(UBound(ArrOrigin, 1), 2).Value = ArrOrigin
Application.ScreenUpdating = True
MsgBox "Controllo eseguito.", vbInformation + vbOKOnly, "OPERAZIONE COMPLETATA"
On Error GoTo 0
End If
End Sub
Come ti avevo già chiesto in precedenza... per nuovi "problemi" apri una nuova discussione visto che il problema per cui è stato aperto questo thread è stato risolto ed eventuali futuri problemi possono dipendere solo da una struttura non conforme al file postato come esempio.
Da questo ti sarà anche più chiara la necessità di approfondire almeno le basi del VBA per poter gestire ulteriori "intoppi".
"Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."
Buonasera, sì hai ragione, se avessi altre cose da chiedere aprirò un'altra discussione, al momento ho risolto il problema che avevo segnalato.
Grazie.
