You are here:Home-Domande su Excel VBA e MACRO-[RISOLTO] Riassumere scadenze in foglio di lavoro
[RISOLTO] Riassumere scadenze in foglio di lavoro2018-11-21T14:34:02+01:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Riassumere scadenze in foglio di lavoro

Visualizzazione 9 filoni di risposte
  • Autore
    Post
    • bg66bg66
      Partecipante
        Post totali: 60

        Buonasera,
        vorrei che all’apertura del file, le date scadute (colonna J) nel foglio di lavoro “DB doc” fossero riassunte nel foglio “Scaduto”.

        Grazie per l’aiuto.

        href=”https://www.dropbox.com/s/bom2du7rbshdoee/GestScadenze%20VForum.xlsm?dl=0″

        • Questo topic è stato modificato 1 anno, 7 mesi fa da bg66bg66.
        • Questo topic è stato modificato 1 anno, 7 mesi fa da sidsid.
      • sidsid
        Moderatore
          Post totali: 749

          Un esempio da mettere in un modulo standard

          Sub SCADUTI()
          
          Dim WS1 As Worksheet, WS2 As Worksheet
          Dim DB As Variant, Matrix() As Variant
          Dim j As Long, nIncr As Long
          
          Set WS1 = Sheets("DB Doc")
          Set WS2 = Sheets("In scadenza")
          
          DB = WS1.Range("A2:J" & WS1.Range("J" & Rows.Count).End(xlUp).Row).Value2
          
          For j = LBound(DB) To UBound(DB)
              If DB(j, 10) < Date Then
                  nIncr = nIncr + 1
                  ReDim Preserve Matrix(1 To 2, 1 To nIncr)
                  Matrix(1, nIncr) = DB(j, 1)
                  Matrix(2, nIncr) = CDate(DB(j, 10))
              End If
          Next j
          WS2.Range("A2:B" & Rows.Count).ClearContents
          
          If nIncr > 0 Then
              WS2.Range("A2:B" & nIncr + 1).Value = Application.Transpose(Matrix)
          End If
          
          Set WS1 = Nothing
          Set WS2 = Nothing
          
          End Sub
        • bg66bg66
          Partecipante
            Post totali: 60

            Ciao Sid,
            grazie per il tuo intervento.
            In realtà volutamente non ho scritto/detto che i dati in scadenza erano 2 perchè volevo provare io a capire lo script per poi correggerlo….ma purtroppo non ci sono riuscito :

            Sub SCADUTI()
            
            Dim WS1 As Worksheet, WS2 As Worksheet
            Dim DB As Variant, Matrix() As Variant
            Dim j As Long, nIncr As Long
            
            Set WS1 = Sheets("DB Doc")
            Set WS2 = Sheets("In scadenza")
            
            DB = WS1.Range("A2:K" & WS1.Range("J" & Rows.Count).End(xlUp).Row).Value2
            
            For j = LBound(DB) To UBound(DB)
                If DB(j, 10) < Date Then
                    nIncr = nIncr + 1
                    ReDim Preserve Matrix(1 To 2, 1 To nIncr)
                    Matrix(1, nIncr) = DB(j, 1)
                    Matrix(2, nIncr) = CDate(DB(j, 10))
                End If
            Next j
            
            For k = LBound(DB) To UBound(DB)
                If DB(k, 11) < Date Then
                    nIncr = nIncr + 1
                    ReDim Preserve Matrix(1 To 2, 1 To nIncr)
                    Matrix(1, nIncr) = DB(k, 1)
                    Matrix(2, nIncr) = CDate(DB(k, 11))
                End If
            Next k
            WS2.Range("A2:C" & Rows.Count).ClearContents
            
            If nIncr > 0 Then
                WS2.Range("A2:B" & nIncr + 1).Value = Application.Transpose(Matrix)
            End If
            
            Set WS1 = Nothing
            Set WS2 = Nothing
            
            End Sub

            Il risultato ottenuto non è quello atteso:

            Attendo tue per capire l’errore….e mi mette anche le altre date all’americana..
            https://www.dropbox.com/s/mglovtkaxbrkcy0/GestScadenze%20VF%20bySid.xlsm?dl=0

            • Questa risposta è stata modificata 1 anno, 7 mesi fa da bg66bg66.
            • Questa risposta è stata modificata 1 anno, 7 mesi fa da bg66bg66.
            • Questa risposta è stata modificata 1 anno, 7 mesi fa da bg66bg66.
          • sidsid
            Moderatore
              Post totali: 749

              Prova così

              Sub SCADUTI()
              
              Dim WS1 As Worksheet, WS2 As Worksheet
              Dim DB As Variant, Matrix() As Variant
              Dim j As Long, nIncr As Long
              
              Set WS1 = Sheets("DB Doc")
              Set WS2 = Sheets("In scadenza")
              
              DB = WS1.Range("A2:J" & WS1.Range("J" & Rows.Count).End(xlUp).Row).Value2
              WS2.Range("B:B").NumberFormat = "dd/mm/yyyy"
              For j = LBound(DB) To UBound(DB)
                  If DB(j, 10) < Date Then
                      nIncr = nIncr + 1
                      ReDim Preserve Matrix(1 To 2, 1 To nIncr)
                      Matrix(1, nIncr) = DB(j, 1)
                      Matrix(2, nIncr) = DB(j, 10)
                  End If
              Next j
              WS2.Range("A2:B" & Rows.Count).ClearContents
              
              If nIncr > 0 Then
                  WS2.Range("A2:B" & nIncr + 1).Value = Application.Transpose(Matrix)
              End If
              
              Set WS1 = Nothing
              Set WS2 = Nothing
              
              End Sub
            • bg66bg66
              Partecipante
                Post totali: 60

                Ciao Sid,
                il risultato ottenuto è diverso dal dato atteso :

                Grazie se puoi.

                Gene

                • Questa risposta è stata modificata 1 anno, 7 mesi fa da bg66bg66.
              • sidsid
                Moderatore
                  Post totali: 749

                  Non capisco se tu vuoi entrambe le date della scadenza; sia della CCIAA sia scadenza 2

                • sidsid
                  Moderatore
                    Post totali: 749

                    Quale date devo verificare, colonna F o colonna J? Oppure entrambe?
                    Il file che hai postato non è lo stesso che vedo nell’immagine.
                    nell’immagine i nomi sono Alfa setx, in quello che ho io il nome è Disneyx

                  • bg66bg66
                    Partecipante
                      Post totali: 60

                      Ciao Sid,
                      allego l’ultima versione su cui faccio le prove.
                      https://www.dropbox.com/s/mglovtkaxbrkcy0/GestScadenze%20VF%20bySid.xlsm?dl=0

                      L’obiettivo sarebbe quello di seguito schematizzato:

                      Grazie ancora.

                    • sidsid
                      Moderatore
                        Post totali: 749

                        Non c’entra nulla con il file che avevo io :-(
                        Prova questo

                        Sub SCADUTI()
                        
                        Dim WS1 As Worksheet, WS2 As Worksheet
                        Dim DB As Variant, Matrix() As Variant
                        Dim j As Long, nIncr As Long
                        
                        Set WS1 = Sheets("DB Doc")
                        Set WS2 = Sheets("In scadenza")
                        
                        DB = WS1.Range("A2:K" & WS1.Range("K" & Rows.Count).End(xlUp).Row).Value2
                        WS2.Range("B:C").NumberFormat = "dd/mm/yyyy"
                        For j = LBound(DB) To UBound(DB)
                            Select Case True
                                Case DB(j, 10) < Date And DB(j, 11) < Date
                                    nIncr = nIncr + 1
                                    ReDim Preserve Matrix(1 To 3, 1 To nIncr)
                                    Matrix(1, nIncr) = DB(j, 1)
                                    Matrix(2, nIncr) = DB(j, 10)
                                    Matrix(3, nIncr) = DB(j, 11)
                                Case DB(j, 10) < Date
                                    nIncr = nIncr + 1
                                    ReDim Preserve Matrix(1 To 3, 1 To nIncr)
                                    Matrix(1, nIncr) = DB(j, 1)
                                    Matrix(2, nIncr) = DB(j, 10)
                                Case DB(j, 11) < Date
                                    nIncr = nIncr + 1
                                    ReDim Preserve Matrix(1 To 3, 1 To nIncr)
                                    Matrix(1, nIncr) = DB(j, 1)
                                    Matrix(3, nIncr) = DB(j, 11)
                                Case Else
                            
                            End Select
                        Next j
                        
                        WS2.Range("A2:C" & Rows.Count).ClearContents
                        
                        If nIncr > 0 Then
                            WS2.Range("A2:C" & nIncr + 1).Value = Application.Transpose(Matrix)
                        End If
                        
                        Set WS1 = Nothing
                        Set WS2 = Nothing
                        
                        End Sub
                      • bg66bg66
                        Partecipante
                          Post totali: 60

                          [RISOLTO]
                          Ciao Sid,
                          è perfetta.
                          Scusami ancora per il refuso.

                          Grazie e alla prossima.
                          Gene

                      Visualizzazione 9 filoni di risposte
                      • Il topic ‘[RISOLTO] Riassumere scadenze in foglio di lavoro’ è chiuso a nuove risposte.