Condividi:        

Smistamento Dati

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Smistamento Dati

Postdi robybarc » 24/08/15 11:21

Salve a tutti,
Ho compilato una macro in VBA che mi smista un certo numero di schede ( 16 in questo caso )
e le mette in un'area a seconda della loro competenza, di stampa o di archiviazione od entrambe.

VEDI FILE ESEMPIO https://www.dropbox.com/s/qd6bojx8u8dtk ... 2.zip?dl=0

Nel file di esempio oltre alla macro in VBA ho anche una macro nel vecchio linguaggio 4.0 .
Entrambe le macro funzionano alla perfezione, ma quella che ho scritto in VBA la trovo troppo complessa e obsoleta e vorrei migliorarla.

questo è il mio compilato:


Codice: Seleziona tutto
Sub SmistaSchede()
     Windows("SmistaSchede2.xlsm").Activate
     Sheets("P0").Select
 
  For h = 1 To 16  ' SCRIVE V NELLE SCHEDE DA STAMPARE E ARCHIVIARE
      Dim rng As Range
      Dim c As Range
      Dim s As String
      Dim sh As Worksheet
      Set sh = ThisWorkbook.Worksheets("P0")
      s = [L6]  ' SCRIVE V NELLE SCHEDE DA STAMPARE E ARCHIVIARE
         Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309").Select
    With sh
        Set rng = .Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309")
        For Each c In rng
              If UCase(c.Value) = UCase(s) Then
                  c.Select
                  ActiveCell = "V"
        Exit For
              End If
          Next
    End With
   Next
      Set sh = Nothing
      Set c = Nothing
      Set rng = Nothing

For i = 1 To 16    ' CANCELLA SCHEDE CON TOT ORE ZERO
      Dim rng1 As Range
      Dim c1 As Range
      Dim s1 As String
      Dim sh1 As Worksheet
      Set sh1 = ThisWorkbook.Worksheets("P0")
      s1 = [L6]  ' ORE ZERO ELIMINO LE SCHEDE VUOTE
         Range("R10,R30,R50,R70,R90,R110,R130,R150,R170,R190,R210,R230,R250,R270,R290,R310").Select
    With sh1
        Set rng1 = .Range("R10,R30,R50,R70,R90,R110,R130,R150,R170,R190,R210,R230,R250,R270,R290,R310")
        For Each c1 In rng1
              If UCase(c1.Value) = UCase(s1) Then
                  c1.Select
    ActiveCell.Offset(-1, -7).Select
    ActiveCell.Resize(20, 8).Select
    Selection.Delete Shift:=xlUp
                  Exit For
              End If
          Next
     End With
   Next
      Set sh1 = Nothing
      Set c1 = Nothing
      Set rng1 = Nothing

For j = 1 To 16   ' CANCELLA SCHEDE SENZA NOME DIPENDENTE
      Dim rng2 As Range
      Dim c2 As Range
      Dim s2 As String
      Dim sh2 As Worksheet
      Set sh2 = ThisWorkbook.Worksheets("P0")
      s2 = [L6]  ' DIPENDENTE VUOTO ELIMINO LE SCHEDE
         Range("N9,N29,N49,N69,N89,N109,N129,N149,N169,N189,N209,N229,N249,N269,N289,N309").Select
    With sh2
        Set rng2 = .Range("N9,N29,N49,N69,N89,N109,N129,N149,N169,N189,N209,N229,N249,N269,N289,N309")
        For Each c2 In rng2
              If UCase(c2.Value) = UCase(s2) Then
                  c2.Select
    ActiveCell.Offset(0, -3).Select
    ActiveCell.Resize(20, 8).Select
    Selection.Delete Shift:=xlUp
        Exit For
              End If
          Next
      End With
   Next
      Set sh2 = Nothing
      Set c2 = Nothing
      Set rng2 = Nothing
 
  For k = 1 To 16   ' ELIMINA SCHEDE DIPENDENTE ASSENTE A
      Dim rng3 As Range
      Dim c3 As Range
      Dim s3 As String
      Dim sh3 As Worksheet
      Set sh3 = ThisWorkbook.Worksheets("P0")
      s3 = [L3]  ' A ELIMINA SCHEDE DIPENDENTE ASSENTE
         Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309").Select
    With sh3
        Set rng3 = .Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309")
        For Each c3 In rng3
              If UCase(c3.Value) = UCase(s3) Then
                  c3.Select
                  ActiveCell.Offset(0, -7).Select
                  ActiveCell.Resize(20, 8).Select
                  Selection.Delete Shift:=xlUp     ' ELIMINA CELLE IN ALTO
        Exit For
              End If
          Next
      End With
   Next
      Set sh3 = Nothing
      Set c3 = Nothing
      Set rng3 = Nothing
 
 For l = 1 To 16   ' COPIA SCHEDE SOLO DA STAMPARE S e le elimina dalla lista da archiviare
      Dim rng4 As Range
      Dim c4 As Range
      Dim s4 As String
      Dim sh4 As Worksheet
      Set sh4 = ThisWorkbook.Worksheets("P0")
      s4 = [L4]  ' S STAMPA E NON ARCHIVIA COPIA SCHEDE DA STAMPARE
         Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309").Select
    With sh4
        Set rng4 = .Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309")
        For Each c4 In rng4
              If UCase(c4.Value) = UCase(s4) Then
                  c4.Select
    ActiveCell.Select               ' SELEZIONA LA CELLA ATTIVA
    ActiveCell = "X"                ' SCRIVE X NELLA CELLA ATTIVA
    ActiveCell.Offset(0, -7).Select
    ActiveCell.Resize(20, 8).Select
    Selection.Copy
    Range("AC9").Select            ' SELEZIONA CELLA
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Exit For
              End If
          Next
      End With
   Next
      Set sh4 = Nothing
      Set c4 = Nothing
      Set rng4 = Nothing
 
  For m = 1 To 16  ' ELIMINA SCHEDE SOLO DA STAMPARE X
      Dim rng5 As Range
      Dim c5 As Range
      Dim s5 As String
      Dim sh5 As Worksheet
      Set sh5 = ThisWorkbook.Worksheets("P0")
      s5 = [L1]  ' A ELIMINA SCHEDE SOLO DA STAMPARE X
         Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309").Select
    With sh5
        Set rng5 = .Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309")
        For Each c5 In rng5
              If UCase(c5.Value) = UCase(s5) Then
                  c5.Select
                  ActiveCell.Offset(0, -7).Select
                  ActiveCell.Resize(20, 8).Select
                  Selection.Delete Shift:=xlUp     ' ELIMINA CELLE IN ALTO
        Exit For
              End If
          Next
      End With
   Next
      Set sh5 = Nothing
      Set c5 = Nothing
      Set rng5 = Nothing
 
 For n = 1 To 16   ' COPIA SCHEDE DA STAMPARE E ARCHIVIARE
      Dim rng6 As Range
      Dim c6 As Range
      Dim s6 As String
      Dim sh6 As Worksheet
      Set sh6 = ThisWorkbook.Worksheets("P0")
      s6 = [L2]  ' COPIA SCHEDE DA STAMPARE E ARCHIVIARE
         Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309").Select
    With sh6
        Set rng6 = .Range("R9,R29,R49,R69,R89,R109,R129,R149,R169,R189,R209,R229,R249,R269,R289,R309")
        For Each c6 In rng6
              If UCase(c6.Value) = UCase(s6) Then
                  c6.Select
                  ActiveCell.Select               ' SELEZIONA LA CELLA ATTIVA
                  ActiveCell = "X"                ' SCRIVE X NELLA CELLA ATTIVA
                  ActiveCell.Offset(0, -7).Select
                  ActiveCell.Resize(20, 8).Select
                  Selection.Copy
                  Range("AC9").Select            ' SELEZIONA CELLA
                  Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
        Exit For
              End If
          Next
      End With
   Next
       Set sh6 = Nothing
      Set c6 = Nothing
      Set rng6 = Nothing
    Application.CutCopyMode = False ' COPIA ANNULLA

End Sub

siccome sto traducendo tutte le macro di un mio programma dal 4.0 al VBA ho molta difficoltà a capire come funziona la logica del VBA.
Spero che qualcuno possa aiutarmi

Grazie
Roberto

EDIT Flash: inserito il codice macro nel Tag Code
E' opportuno che ogni utente utilizzi il Tag Code per formule ma, soprattutto, per il codice macro
robybarc
Utente Junior
 
Post: 17
Iscritto il: 09/05/15 10:36

Sponsor
 

Re: Smistamento Dati

Postdi Anthony47 » 24/08/15 14:21

Il linguaggio vba e' molto diverso e molto piu' potente del linguaggio Macro 4.0; se devi fare molte conversioni e' proprio necessario che acquisisci i fondamenti del linguaggio, che ti possono essere dati da qualche buon libro sull'argomento: se visiti una Feltrinelli o una Mondadori, o un'altra fornita libreria della tua citta', troverai sicuramente dei testi che ti guideranno per "il primo miglio"; per il resto della strada solo la pratica ti aiutera' in modo sostanziale.

Per quanto riguarda la situazione specifica, se descrivi il problema da risolvere certamente qualche contributo ti arrivera'; personalmente non ho l'abitudine di decodificare una macro per farmi un'idea, e queso non solo per rispetto del mio stesso tempo ma perche' solo l'utente sa quel che cerca...

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Smistamento Dati

Postdi robybarc » 24/08/15 15:59

Ciao Anthony,
sono perfettamente d'accordo con te sul fatto che non devi farti un'idea su quello che voglio e soprattutto sul fatto che non hai tempo da dedicarmi per risolvere il mio problema in modo sostanziale.
Forse mi sono spiegato male nell'illustrare il mio problema, io mi sono costruito la macro in VBA usando la mia limitata conoscenza del linguaggio e la macro funziona perfettamente, però ho dovuto ragionare nello stesso modo che usavo con il vecchio codice ma credo che con il VBA debba aprire i miei orizzonti di pensiero a 360 gradi e ho molta difficoltà.
Con questo mio post speravo di ricevere un suggerimento su come costruire quel ciclo ( For h = 1 To 16 .........Next ) che ho ripetuto sette volte quando magari potevo nidificare tutto in una volta soltanto ed evitare di fargli fare il controllo 16X16X7 volte quando magari si poteva fare solo con 16 passaggi.
Ad ogni modo il file di esempio se può essere utile lo trovo qui.
https://www.dropbox.com/s/qd6bojx8u8dtk ... 2.zip?dl=0

Grazie
Roberto
robybarc
Utente Junior
 
Post: 17
Iscritto il: 09/05/15 10:36

Re: Smistamento Dati

Postdi Anthony47 » 25/08/15 23:24

robybarc ha scritto: sono perfettamente d'accordo con te sul fatto che non devi farti un'idea su quello che voglio [. . . ]
Credo di aver capito...
robybarc ha scritto: [. . . ] e soprattutto sul fatto che non hai tempo da dedicarmi per risolvere il mio problema in modo sostanziale.
Ma io non ho detto che non ho tempo per te, ne' lo diro' mai a nessuno (se non ho tempo o voglia sto zitto e basta).
Ho detto "se descrivi il problema da risolvere certamente qualche contributo ti arrivera'; personalmente non ho l'abitudine di decodificare una macro per farmi un'idea [. . .]"
E se dici che ti serve un aiuto per migliorare l'impostazione di quanto hai scritto ma ancora non descrivi quello che la macro alla fine deve fare, stai chiedendo di decodificare una macro per capire che cosa fa (in modo lineare, inteso come un passo dopo l'altro) per poterla riscrivere in modo piu' semplice e strutturata.

Comunque hai inserito la stessa domanda in due discussioni diverse; chi ha voglia continui qui: viewtopic.php?f=26&t=105259
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Smistamento Dati":


Chi c’è in linea

Visitano il forum: Ricky0185 e 33 ospiti