You are here:Home-Domande su Excel VBA e MACRO-[RISOLTO] Elenco creato da Macro. Ordinamento dei dati
[RISOLTO] Elenco creato da Macro. Ordinamento dei dati2018-09-20T12:51:07+02:00

Home Forum Domande su Excel VBA e MACRO [RISOLTO] Elenco creato da Macro. Ordinamento dei dati

Visualizzazione 5 filoni di risposte
  • Autore
    Post
    • antinoantino
      Partecipante
        Post totali: 38

        Buona sera al Forum,
        Con la macro sotto riportata viene creato un elenco con in fondo un totale.
        Vorrei che prima del totale l’elenco stesso venisse ordinato secondo l’ordine ascendente della colonna A (da A3 alla fine dell’elenco).
        Grazie dell’aiuto

        Option Explicit
        Sub crea_report()
        Application.ScreenUpdating = False
        
        Dim wb As Workbook
        Dim wb1 As Workbook
        Dim wb2 As Workbook
        Dim ultD As Long
        Dim ultG As Long
        Dim diff As Single
        Dim imp1 As Single
        Dim imp2 As Single
        Dim riga As Long
        Dim Ws As Worksheet
        Dim aperto As Boolean
        
        'VERIFICO SE IL FILE "Schede Clienti.xlsm" è APERTO
        For Each wb In Application.Workbooks
        If wb.Name = "Schede Clienti.xlsm" Then
        aperto = True
        Exit For
        End If
        Next wb
        
        'SE è CHIUSO LO APRO
        If Not aperto Then
        Workbooks.Open ("L:\FATTURAZIONE\Schede Clienti.xlsm")
        End If
        
        Set wb1 = Workbooks("Schede Clienti.xlsm")
        Set wb2 = Workbooks.Add
        riga = 3
        ' On Error GoTo uscita
        
        'FORMATTO IL FOGLIO1 DEL NUOVO FILE
        With wb2.Sheets("Foglio1")
        .Range("A1").Value = "SITUAZIONE CLIENTI AL " & Date
        With .Range("A1:D1")
        .Borders.Weight = xlMedium
        .Borders.LineStyle = xlContinuous
        .Merge
        .HorizontalAlignment = xlCenter
        .font.Bold = True
        End With
        .Range("A2").Value = "CLIENTE"
        .Range("B2").Value = "FATTURATO"
        .Range("C2").Value = "PAGATO"
        .Range("D2").Value = "DIFFERENZA"
        .Columns("B:D").NumberFormat = "#,##0.00"
        .Rows(1).RowHeight = 25
        With .Range("A2:D2")
        .HorizontalAlignment = xlCenter
        .font.Bold = True
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlMedium
        End With
        End With
        
        'CICLO I FOGLI DEL FILE PRINCIPALE
        For Each Ws In wb1.Worksheets
        With wb1.Sheets(Ws.Name)
        ultD = IIf(.Range("D3").Value = "", 3 _
        , .Range("D" & Rows.Count).End(xlUp).Row)
        ultG = IIf(.Range("G3").Value = "", 3 _
        , .Range("G" & Rows.Count).End(xlUp).Row)
        imp1 = Application.WorksheetFunction.Sum _
        (.Range("D3:D" & ultD))
        imp2 = Application.WorksheetFunction.Sum _
        (.Range("G3:G" & ultG))
        diff = imp1 - imp2
        With wb2.Sheets("Foglio1")
        If diff <> 0 Then
        .Range("A" & riga).Value = wb1.Sheets(Ws.Name).Range("A1").Value
        .Range("B" & riga).Value = imp1
        .Range("C" & riga).Value = imp2
        diff = CSng(Format(imp1 - imp2, "#,##0.00"))
        .Range("D" & riga).Value = diff
        imp1 = 0
        imp2 = 0
        riga = riga + 1
        End If
        End With
        End With
        Next Ws
        'ADATTO LA LARGHEZZA DELLE COLONNE.
        'SELEZIONO IL TITOLO.
        'INSERISCO LA STRINGA "TOTALE" 2 RIGHE DOPO L'ULTIMA CELLA PIENA COL "A".
        'INSERISCO IL TOTALE DELLE DIFFERENZE IN FONDO ALLA COLONNA "D"
        'ADATTO I MARGINI DELLA PAGINA PER LA STAMPA
        
        With wb2.Sheets("Foglio1")
        .Columns("A:D").AutoFit
        .Range("A1:D1").Select
        .Range("A" & riga + 1).Value = "TOTALE"
        .Range("D" & riga + 1).Value = _
        Application.WorksheetFunction.Sum(.Range("D3:D" & riga - 1))
        End With
        With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.26)
        .RightMargin = Application.InchesToPoints(0.34)
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        
        End With
        
        'CHIUDO IL FILE "Schede Clienti.xlsm"
        wb1.Close
        
        ' uscita:
        ' If Err.Number <> 0 Then
        ' MsgBox Err.Description
        ' wb2.Close
        ' End If
        
        Set wb1 = Nothing
        Set wb2 = Nothing
        
        Application.ScreenUpdating = True
        End Sub
        
        
        • Questo topic è stato modificato 1 anno, 9 mesi fa da sidsid.
      • BySalvBySalv
        Amministratore del forum
          Post totali: 720

          Ciao, avresti fatto prima ad allegare il file, come faccio a fare le prove per vedere se funziona?.

          può darsi che la macro sia esatta e funzioni bene, ma un formato dei dati sbagliato, oppure hai indicato un indirizzo cella diverso.

          oltre che anche se mi creassi(tu lo hai già) un ipotetico file dati non sarà mai uguale al tuo, sia come formato o come dati, ecco alcuni dei motivi che cerchiamo il file, crea un file ridotto togliendo dati sensibili, mettendo dei dati fasulli nelle posizioni sensibili.

          Ciao By Sal :bye:

          Ciao By Sal (8-)
          se ti piace la soluzione aiuta a sostenere il Forum con una DONAZIONE a piacere, Grazie

        • antinoantino
          Partecipante
            Post totali: 38

            Ciao Bysal,

            E’ un programma alquanto complesso che è stato creato con il notevole aiuto di Sid ed inserito nel vecchio sito tra i “Vostri lavori Excel”.

            L’elenco che scaturisce dalla macro suddetta va a prendere i dati anche in una cartella al di fuori di quella in cui è inserita la macro.

            In realtà funziona tutto alla perfezione soltanto che ogni volta devo manualmente provvedere ad ordinarlo in forma crescente in base ai dati della colonna “A” (Clienti).

            Ciò dovrebbe avvenire dopo questa parte di codice e prima della chiusura del file

            'ADATTO LA LARGHEZZA DELLE COLONNE.
            'SELEZIONO IL TITOLO.
            'INSERISCO LA STRINGA "TOTALE" 2 RIGHE DOPO L'ULTIMA CELLA PIENA COL "A".
            'INSERISCO IL TOTALE DELLE DIFFERENZE IN FONDO ALLA COLONNA "D"
            'ADATTO I MARGINI DELLA PAGINA PER LA STAMPA
            
            With wb2.Sheets("Foglio1")
            .Columns("A:D").AutoFit
            .Range("A1:D1").Select
            .Range("A" & riga + 1).Value = "TOTALE"
            .Range("D" & riga + 1).Value = _
            Application.WorksheetFunction.Sum(.Range("D3:D" & riga - 1))
            End With
            With ActiveSheet.PageSetup
            .LeftMargin = Application.InchesToPoints(0.26)
            .RightMargin = Application.InchesToPoints(0.34)
            .FitToPagesWide = 1
            .FitToPagesTall = 1
            
            End With
          • antinoantino
            Partecipante
              Post totali: 38

              Ciao BySalv,

              Ho trovato la soluzione.

              Dopo quella parte di macro e prima della chiusura ho inserito questo codice

               `wb2.Sheets(“Foglio1”).Sort.SortFields.Add Key:=Range(“A2:A” & riga – 1) _
              , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
              With ActiveSheet.Sort
              .SetRange Range(“A2:D” & riga – 1)
              .Header = xlYes
              .MatchCase = False
              .Orientation = xlTopToBottom
              .SortMethod = xlPinYin
              .Apply
              End With`
              e tutto è andato a posto.
              Inserisco “risolto”.
              Grazie di tutto.
              Un saluto carissimo a Sid che non sento da tanto tempo.

            • antinoantino
              Partecipante
                Post totali: 38

                Ciao BySalv

                Non riesco ad inserire Risolto.
                Non mi compare Modifica all’inizio del post.
                Come fare?
                Grazie

              • sidsid
                Moderatore
                  Post totali: 749

                  Un semplice utente non visualizza l’opzione “modifica”.
                  Ci penso io; ciao :bye:

              Visualizzazione 5 filoni di risposte
              • Il topic ‘[RISOLTO] Elenco creato da Macro. Ordinamento dei dati’ è chiuso a nuove risposte.