Segnalazione tramite Remind dati mancanti ed inserimento dati in tabella

[FROST220684Partecipante FROST220684]

Ciao a tutti,

Avrei necessità di implementare una funzione all'interno del file allegato. In pratica all'apertura file avrei bisogno che mi venga aperto un avviso che mi dica a distanza di 7 giorni dall'arrivo delle date inserite nel foglio transfer se mancano dati in alcune celle:

Ad esempio:

1. All'interno del foglio transfer le righe sono identificate da un codice univoco (colonna L) e da una lettera A (andata) o R (ritorno) nella colonna K.

2. Ho inserito 2 ospiti (esempio 1 ed esempio 2)

3. nel remind all'apertura foglio mi servirebbe sapere se per l'esempio 1 che è un andata se la cella g5 non è compilata segnala

- nell'esempio 2 che invece è un ritorno mi servirebbe controllare se le celle H12 ed I12 non sono compilate ed in tal caso segnalarle.

----------------------------------------------------------------------------------

Successivamente al remind di aperura file vorrei che quei dati vengano inseriti in una sorta di tabella (che io ho inserito nel foglio pannello di controllo e se c'è un metodo graficamente migliore accetto consigli) che mi tenga aggiornato sui dati mancanti con la data di arrivo ed il nome dell'ospite per cui mancano i dati.

Spero di essermi spiegato bene e se ci sono domande sono qui.

Grazie mille per l'aiuto

Allegati:

You must be logged in to view attached files.

[rollis13Partecipante rollis13 Karma: 8 pts]

Aggiungi questa macro in un modulo e poi richiamala come prima riga nella macro "Workbook_Open" e fai delle prove.

Option Explicit
Sub SegnalaOmessi()
    Dim x     As Long
    Dim y     As Long
    Dim ur1   As Long
    Dim ur2   As Long
    Application.ScreenUpdating = False
    ur1 = Sheets("Transfer").Range("B" & Rows.Count).End(xlUp).Row
    ur2 = Sheets("Pannello di Controllo").Range("F" & Rows.Count).End(xlUp).Row
    y = 12
    Sheets("Pannello di Controllo").Range("F" & y & ":G" & ur2).ClearContents
    With Sheets("Transfer")
        For x = 4 To ur1
            If Date - 7 > .Cells(x, "B") Then
                If .Cells(x, "K") = "A" Then
                    If .Cells(x, "G") = "" Then
                        Sheets("Pannello di Controllo").Cells(y, "F") = .Cells(x, "C")
                        Sheets("Pannello di Controllo").Cells(y, "G") = .Cells(x, "B")
                    End If
                ElseIf .Cells(x, "K") = "R" Then
                    If .Cells(x, "H") = "" Or .Cells(x, "I") = "" Then
                        Sheets("Pannello di Controllo").Cells(y, "F") = .Cells(x, "C")
                        Sheets("Pannello di Controllo").Cells(y, "G") = .Cells(x, "B")
                    End If
                End If
                y = y + 1
            End If
        Next x
    End With
    Application.ScreenUpdating = True
End Sub

[alexps81Moderatore alexps81 Karma: 58 pts]

      caspita ci stavo lavorando anche io...va be' la pubblico lo stesso poi vede lui quale utilizzare.

Dunque la mia però prevede l'utilizzo di una ListBox (controllo ActiveX) sul Foglio "Pannello di Controllo". Quindi il primo passaggio è quello di eliminare quella tabella sul Foglio "Pannello di Controllo" e disegnare al suo posto una ListBox. I passaggi sarebbero:

1) Fai click su Sviluppo, Inserisci, Controlli ActiveX Casella di Riepilogo.

2) Disegni la ListBox al posto della tabella. Larghezza (Width) = 310 e Altezza (Height) = 152. Il FontSize scegli 14...cmq queste cose le puoi scegliere anche dopo a tuo piacimento.

3) nella cella F10 scrivi "Cliente - data arrivo - dato mancante"

4) in un nuovo modulo inserisci questo codice

Option Explicit

Public Sub checkDate()
Dim targetDate As Date
Dim rngDate As Range, data As Range
Dim listBox As Object
Dim s As String

targetDate = DateAdd("d", 7, Date)
    
Set rngDate = ThisWorkbook.Sheets("Transfer").Range("B4", ThisWorkbook.Sheets("Transfer").Range("B4").End(xlDown))
Set listBox = ThisWorkbook.Sheets("Pannello di Controllo").OLEObjects("ListBox1").Object

listBox.Clear
s = ""
For Each data In rngDate
    If DateValue(data.Value) >= Date Then
        If DateValue(data.Value) <= DateValue(targetDate) Then
            Select Case data.Offset(, 9)
                Case "A"
                    If data.Offset(, 5) = "" Then
                        s = s & vbCrLf & """Ora Arrivo"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value & "  -  Ora Arrivo"
                    End If
                Case "R"
                    If data.Offset(, 6) = "" Then
                        s = s & vbCrLf & """Ora Partenza"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value & "  -  Ora Partenza"
                    End If
                    
                    If data.Offset(, 7) = "" Then
                        s = s & vbCrLf & """Ora Transfer"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value & "  -  Ora Transfer"
                    End If
            End Select
        End If
    End If
Next data

MsgBox s, vbInformation, "Attenzione..."

Set rngDate = Nothing
Set listBox = Nothing

End Sub

5) nell'evento Open del Workbook aggiungi  Call checkDate

6) salva, chiudi e riapri.

 

Preferisco la ListBox così anche se hai tanti clienti da elencare almeno hai spazio rispetto a quella tabella che hai creato sul Foglio

[FROST220684Partecipante FROST220684]

Grazie ad entrambi per l'aiuto ottima soluzione come sempre risolutiva.

Effettivamente come miglioria grafica intendevo proprio qualcosa come la casella di riepilogo che non conoscevo quindi molto meglio della mia bruttissima tabella.

Non riesco solo a modificare una cosa:

A me non interessa il dato mancante anche perchè se mancano più dati viene ripetuto nella listview:

Es. Se del cliente esempio mancano ora partenza e ora transfer avrò due righe in casella riepilogo.

Preferirei avere soltanto Ospite e data di arrivo. Alla fine deve servire come promemoria per andare a vedere quindi già il fatto che lo segnala deve portare alla verifica e cosi eliminerei il problema della ripetitività della linea. Ho provato ad eliminare una parte di codice ma non mi va. tipo cosi:

Option Explicit

Public Sub checkDate()
Dim targetDate As Date
Dim rngDate As Range, data As Range
Dim listBox As Object
Dim s As String

targetDate = DateAdd("d", 7, Date)
    
Set rngDate = ThisWorkbook.Sheets("Transfer").Range("B4", ThisWorkbook.Sheets("Transfer").Range("B4").End(xlDown))
Set listBox = ThisWorkbook.Sheets("Pannello di Controllo").OLEObjects("ListBox1").Object

listBox.Clear
s = ""
For Each data In rngDate
    If DateValue(data.Value) >= Date Then
        If DateValue(data.Value) <= DateValue(targetDate) Then
            Select Case data.Offset(, 9)
                Case "A"
                    If data.Offset(, 5) = "" Then
                        s = s & vbCrLf & """Ora Arrivo"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value & "
                    End If
               
            End Select
        End If
    End If
Next data
MsgBox s, vbInformation, "Attenzione..."
Set rngDate = Nothing
Set listBox = Nothing

End Sub

cosa sbaglio???

[alexps81Moderatore alexps81 Karma: 58 pts]

Prova a vedere se ho capito. Con questa modifica, il cliente associato al dato "R", se almeno un dato è mancante tra Ora Partenza o Ora Transfer, allora viene inserito nella ListBox, altrimenti se entrambi i dati mancano verrà sempre inserito solo quel cliente senza ripeterlo.

 

Option Explicit

Public Sub checkDate()
Dim targetDate As Date
Dim rngDate As Range, data As Range
Dim listBox As Object
Dim s As String

targetDate = DateAdd("d", 7, Date)
    
Set rngDate = ThisWorkbook.Sheets("Transfer").Range("B4", ThisWorkbook.Sheets("Transfer").Range("B4").End(xlDown))
Set listBox = ThisWorkbook.Sheets("Pannello di Controllo").OLEObjects("ListBox1").Object

listBox.Clear
s = ""
For Each data In rngDate
    If DateValue(data.Value) >= Date Then
    data.Select
        If DateValue(data.Value) <= DateValue(targetDate) Then
            Select Case data.Offset(, 9)
                Case "A"
                    If data.Offset(, 5) = "" Then
                        s = s & vbCrLf & """Ora Arrivo"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value
                    End If
                Case "R"
                    If data.Offset(, 6) = "" Or data.Offset(, 7) = "" Then
                        s = s & vbCrLf & """Ora Partenza/Trasfer"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value
                    End If
            End Select
        End If
    End If
Next data

MsgBox s, vbInformation, "Attenzione..."

Set rngDate = Nothing
Set listBox = Nothing

End Sub

  

[FROST220684Partecipante FROST220684]

Quello che hai capito va bene. mi va in debug qui in allegato

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

ok è bastato eliminarlo e funziona mi pare do un occhiata

[FROST220684Partecipante FROST220684]

si va benissimo tutto ok   

Allegati:

You must be logged in to view attached files.

[FROST220684Partecipante FROST220684]

Grazie mille Alexxxxxxx   

[FROST220684Partecipante FROST220684]

versione definitiva e corretta:

`Option Explicit

Public Sub checkDate()
Dim targetDate As Date
Dim rngDate As Range, data As Range
Dim listBox As Object
Dim s As String

targetDate = DateAdd("d", 7, Date)
    
Set rngDate = ThisWorkbook.Sheets("Transfer").Range("B4", ThisWorkbook.Sheets("Transfer").Range("B4").End(xlDown))
Set listBox = ThisWorkbook.Sheets("Pannello di Controllo").OLEObjects("ListBox1").Object

listBox.Clear
s = ""
For Each data In rngDate
    If DateValue(data.Value) >= Date Then
    
        If DateValue(data.Value) <= DateValue(targetDate) Then
            Select Case data.Offset(, 9)
                Case "A"
                    If data.Offset(, 5) = "" Then
                        s = s & vbCrLf & """Ora Arrivo"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value
                    End If
                Case "R"
                    If data.Offset(, 6) = "" Or data.Offset(, 7) = "" Then
                        s = s & vbCrLf & """Ora Partenza/Trasfer"" del cliente " & data.Offset(, 1) & " del " & data & " non compilato."
                        listBox.AddItem data.Offset(, 1).Value & "  -  " & data.Value
                    End If
            End Select
        End If
    End If
Next data

MsgBox s, vbInformation, "Attenzione..."

Set rngDate = Nothing
Set listBox = Nothing

End Sub`

[alexps81Moderatore alexps81 Karma: 58 pts]

FROST220684 ha scritto:

ok è bastato eliminarlo e funziona mi pare do un occhiata

Si hai ragione, era un refuso. Stavo facendo delle prove per avere un riscontro visivo della cella attiva. Non serve...hai fatto bene a cancellare quel rigo di codice.

[Autore]

Articoli