Excel e gli applicativi Microsoft Office Selezione dati su file in base a data

LoginRegistrati
Stai vedendo 3 articoli - dal 1 a 3 (di 3 totali)
  • Autore
    Articoli
  • #16741 Risposta

    danros
    Partecipante

      Salve a tutti.

      Ho una macro che all'apertura mi chiede la data di inizio e la data di fine.

      Poi apre lo shell e mi chiede di selezionare i file. Questi sono tutti nella stessa cartella e hanno sempre il nome composto da ip plc _ data in formato rovescio (aaaa-m-g h-m-s) . csv =

      ad esempio

      [ 192.168.1.21_2019-6-10 18-4-57.csv ] ... oppure

      [192.168.1.22_2018-1-3 12-9-37.csv]

      Avrei bisogno di togliermi la rogna della selezione dei file, facendo in modo che la macro aprisse solo i file con il range di date impostato.

      Avevo poi pensato a due strade:

      1. imposto nella ricerca dei file un certo offset, diciamo di +- 5 giorni.

      2. Per me abbastanza difficile: Inserisco un blocco per cui la routine apre il file con la data più vicina alla fine dell'intervallo e procede ad aprire i file e a copiare fino ad arrivare alla data di inizio - 1 gg (in modo che prenda tutto il giorno di inzio intervallo.)

      Il percorso dei file e l'IP del plc devono essere definiti a livello di codice (non serve su celle di excel)

       

      Grazie a tutti.

       

       

      Al momento il codice che funziona è questo.

      '=========>>
      Option Explicit

      '--------->>
      Public Sub Unisci_file_universale()
      Dim srcWB As Workbook, destWB As Workbook
      Dim srcSH As Worksheet, destSH As Worksheet
      Dim srcRng As Range, destRng As Range
      Dim FD As FileDialog
      Dim vFile As Variant
      Dim dtInizio As Date, dtFine As Date
      Dim vInizio As Variant, vFine As Variant
      Dim sMsg As String
      Dim iInizio As Long, iFine As Long
      Dim LRow As Long
      Dim bNewSheet As Boolean
      Dim OGGi
      OGGi = Now ' Assign current system date and time.

      Const sFoglioDestinazione As String = "Foglio1" '<<=== Modifica

      vInizio = Application.InputBox( _
      Prompt:="Immetti la data iniziale", _
      Title:="Inizio", _
      Type:=2)

      On Error Resume Next
      If TypeName(vInizio) = "String" Then
      dtInizio = DateValue(vInizio)
      If IsDate(dtInizio) And dtInizio > 1 Then
      iInizio = CLng(dtInizio)
      Else
      sMsg = "Non hai inserito una data valida!"
      GoTo XIT
      End If
      Else
      sMsg = "Non hai inserito una data valida!"
      GoTo XIT
      End If

      vFine = Application.InputBox( _
      Prompt:="Immetti la data Finale", _
      Title:="Fine", _
      Type:=2)

      ' QUI C'ERA IL MESSAGGIO

      If TypeName(vFine) = "String" Then
      dtFine = DateValue(vFine)
      If IsDate(dtFine) And dtFine > 1 Then
      iFine = CLng(dtFine)
      Else
      ' sMsg = "Non hai inserito una data valida!"
      ' GoTo XIT
      iFine = OGGi 'se non inserisco dati mi prende la data di oggi
      End If
      Else
      sMsg = "Non hai inserito una data valida!"
      GoTo XIT
      ' iFine = OGGi 'se non inserisco dati mi prende la data di oggi
      End If
      On Error GoTo 0
      Application.ScreenUpdating = False ' (verificare se meglio lasciare questo)

      Set destWB = ActiveWorkbook

      With destWB
      If SheetExists(sFoglioDestinazione) Then
      Set destSH = .Sheets(sFoglioDestinazione)
      destSH.UsedRange.Offset(1).ClearContents
      Else
      Set destSH = .Sheets.Add( _
      After:=.Sheets(.Sheets.Count))
      destSH.Name = sFoglioDestinazione
      bNewSheet = True
      End If
      End With

      Set FD = Application.FileDialog(msoFileDialogFilePicker)
      On Error GoTo XIT

      With FD
      .AllowMultiSelect = True
      .Show
      If .SelectedItems.Count = 0 Then
      sMsg = "Non hai selezionato alcun file da interrogare!"
      GoTo XIT
      End If

      For Each vFile In .SelectedItems
      Application.ScreenUpdating = False

      Set srcWB = Workbooks.Open(vFile)
      ' Application.ScreenUpdating = False

      Set srcSH = srcWB.Worksheets(1)
      ' srcWB.Windows(1).Visible = False 'aggiunto per evitare che compaiano le varie finestre

      Call D_da_plc_separazione_data

      With srcSH
      .Range("a1").AutoFilter
      .AutoFilter.Range.AutoFilter _
      Field:=2, _
      Criteria1:=">=" & iInizio, _
      Operator:=xlAnd, _
      Criteria2:="<=" & iFine
      Set srcRng = .AutoFilter.Range.Offset(1)
      End With

      With destSH
      LRow = LastRow(destSH, .Columns("A"))
      Set destRng = .Range("A" & LRow + 1)
      'ERA Set destRng = .Range("A" & LRow + 1)

      End With

      srcRng.Copy Destination:=destRng
      srcWB.Close SaveChanges:=False
      Next vFile
      End With

      Application.ScreenUpdating = True ' (verificare se meglio lasciare questo)

      With destSH.UsedRange
      .RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), _
      Header:=xlNo
      .Sort Key1:=.Range("A1"), _
      Order1:=xlAscending, _
      Header:=xlYes, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom, _
      SortMethod:=xlPinYin
      If bNewSheet Then
      .EntireColumn.AutoFit
      End If
      End With

      sMsg = "Finito!"

      XIT:
      With Application
      .CutCopyMode = False
      .ScreenUpdating = True
      End With
      If sMsg <> vbNullString Then
      Call MsgBox( _
      Prompt:=sMsg, _
      Buttons:=vbInformation, _
      Title:="OPERAZIONE " _
      & IIf(sMsg = "Finito!", "COMPLETATA!", "CANCELLATA!"))
      End If
      End Sub

      '--------->>
      Public Function LastRow(SH As Worksheet, _
      Optional rng As Range, _
      Optional minRow As Long = 1, _
      Optional sPassword As String)
      Dim bProtected As Boolean

      With SH
      If rng Is Nothing Then
      Set rng = .Cells
      End If
      bProtected = .ProtectContents = True
      If bProtected Then
      Application.ScreenUpdating = False
      .Unprotect Password:=sPassword
      End If
      End With
      On Error Resume Next
      LastRow = rng.Find(What:="*", _
      After:=rng.Cells(1), _
      Lookat:=xlPart, _
      LookIn:=xlFormulas, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlPrevious, _
      MatchCase:=False).Row

      'GENERA ERRORE IN QUANTO SOVRASCRIVE LastRow = rng.Find(What:="*", _
      After:=rng.Cells(0), _
      Lookat:=xlPart, _
      LookIn:=xlFormulas, _
      SearchOrder:=xlByRows, _
      SearchDirection:=xlPrevious, _
      MatchCase:=False).Row
      On Error GoTo 0
      If LastRow < minRow Then
      LastRow = minRow
      End If

      If bProtected Then
      SH.Protect Password:=sPassword, _
      UserInterfaceOnly:=True
      End If
      Application.ScreenUpdating = True
      End Function

      '--------->>
      Public Function SheetExists(sSheetName As String, _
      Optional ByVal WB As Workbook) As Boolean
      On Error Resume Next
      If WB Is Nothing Then
      Set WB = ThisWorkbook
      End If
      SheetExists = CBool(Len(WB.Sheets(sSheetName).Name))
      On Error GoTo 0
      End Function
      '<<=========

      #16746 Risposta
      albatros54
      albatros54
      Moderatore
      • Sfida #2
        34 pts

        Ciao danros, oltre ad allegare il codice è sempre meglio allegare un file ,senza dati sensibili, perchè chi vuole prendere in carico il tuo post per cercarti di aiutarti, deve ricreare da zero lo scenario per fare girare il tuo codice, e molte volte  i post non vengono prese in considerazione per questo fatto  

         

         

        Qual è il punto di avere gusti diversi, se non mostrare che i cervelli lavorano diversamente, che pensiamo diversamente? ( Alan Turing)
        Sempre il mare, uomo libero, amerai!
        ( Charles Baudelaire )
        #16796 Risposta

        danros
        Partecipante

          Grazie per la dritta.

          Allora allego 3 file con i dati e  il personal DR.xlb che contiene le varie parti di codice.

          Solitamente apro un file excel vuoto, lancio la macro "log plc e grafico pivot con selezione date e unione file"

          Lui si arrangia chiedendomi i file da usare.

          Questa è la parte che vorrei evitare, avendo già selezionato le date interessanti.

          Allegati:
          You must be logged in to view attached files.
        LoginRegistrati
        Stai vedendo 3 articoli - dal 1 a 3 (di 3 totali)
        Rispondi a: Selezione dati su file in base a data
        Gli allegati sono permessi solo ad utenti REGISTRATI
        Le tue informazioni:



        vecchio frac - 1993 risposte

        albatros54
        albatros54 - 640 risposte

        patel
        patel - 499 risposte

        Marius44
        Marius44 - 402 risposte

        Luca73
        Luca73 - 365 risposte