Ciclo condizionato con macro excel

Hai un problema con Excel?

Nuova discussione

Ciclo condizionato con macro excel
di gavasato (utente non iscritto) data: 25/01/2015 11:44:30
Vi anticipo che sono inesperto di VB e di macro. Comunque guardando il vostro interessante forum, copiano di quà e di la ho tirato fuori un tentativo di di codice che mi dovrebbe permettere di fare queste cose:
ci sono diversi fogli dove sono presenti delle colonne (denominate A,B...) con dei titoli (DATA,....) e in righe successive (dalla 13 riga in poi) delle date e numeri. Nello stesso foglio queste colonne potrebbero ripetersi sino a 5 volte con le stesse denominazioni. Tra le altre cose gli intervalli di ripeticione non sono sempre gli stessi dato che possono essere aggiunti o eliminate delle righe. Avrei necessità di copiare le righe (B,C,D) su un foglio Riassunto. Vi riporto un tentativo scopiazzato di codice che però nn mi funziona, potreste darmi una mano?

A B C D E...|..A B C D E.......
- DATA mcc mcs .... | - DATA mcc mcs ....

Sub Recap()
Dim Riga_Tot As Integer, n As Integer
Dim Foglio As Worksheet, wk1 As Workbook
Dim intervallo As Double, inizio As Double, fine As Double, minuti As Double
Dim myRange  As Range
Dim cerca As Long
Dim c As Range
Dim d As Integer
Dim Interno As Range
Dim MyColumn As String, Here As String
 Dim dopocolonna As String
 Dim dopocolonnadopo As String
 

Application.ScreenUpdating = False
Application.Calculate
'inizio = Timer

Set wk1 = ThisWorkbook

Riga_Tot = 2

With Worksheets("Foglio1")
'    Range("A1:E400").Clear


For Each Foglio In Worksheets
        If Foglio.Name <> "Foglio1" Then
            With Foglio
                  Set myRange = .Range("a12:g12")
                   
                      For Each c In myRange
                          If c.Value = "mc caricati" Then
                          Here = c.Cells.Address
                          ' MsgBox c.Cells.Column
                          dopocolonna = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
                      Exit For
                          End If
                      Next
            
                      For Each c In myRange
                          If c.Value = "mc smaltiti" Then
                          Here = c.Cells.Address
                          ' MsgBox c.Cells.Column
                          dopocolonnadopo = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
                      Exit For
                          End If
                      Next
                      For Each c In myRange
                          If c.Value = "DATA" Then
                          Here = c.Cells.Address
                          ' MsgBox c.Cells.Column
                          MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
                          ' c = Range(MyColumn & Rows.Count).End(xlUp).Row
                      Exit For
                          End If
                      Next
            End With
                     'd = Range(MyColumn & Rows.Count).End(xlUp).Row
                     'Set Interno = Range("B2:T48")
                     'Range("B2:T48").Name = "Interno"
                     ' Range("Interno").Select
                     ' n = Range("Interno").Range(MyColumn & 48).End(xlUp).Row
            n = Foglio.Cells(48, c.Cells.Column).End(xlUp).Row
           
                 For n = 1 To n - 12
                     Foglio.Range(MyColumn & n + 12).Copy .Range("a" & Riga_Tot)
                     Foglio.Range(dopocolonna & n + 12).Copy .Range("b" & Riga_Tot)
                     Foglio.Range(dopocolonnadopo & n + 12).Copy .Range("c" & Riga_Tot)
                     Foglio.Range(MyColumn & 3).Copy .Range("d" & Riga_Tot)
                     Foglio.Range(MyColumn & 2).Copy .Range("e" & Riga_Tot)
                    
                     Riga_Tot = Riga_Tot + 1
                Next
            
            d = 12
            
            'Loop attraverso le celle della riga12
            'Si esce dal ciclo se la cella (Cells (12, d1)) è vuota
            While Not IsEmpty(Cells(12, d))
        'Scrivere il contenuto della cella nella finestra di esecuzione.
        'Debug.Print Cells(3, i + 1)
        
            
                        
           With Foglio
                Set myRange = .Range("Cells(12, d): Cells(12, d + 7)")
                   ' RR = Range("H" & Rows.Count).End(xlUp).Row
              ' If RR = 1 Then
              '  RR = 7
               '  End If
               '   GoTo Foglio
                  For Each c In myRange
                      If c.Value = "mc caricati" Then
                         Here = c.Cells.Address
                         ' MsgBox c.Cells.Column
                         dopocolonna = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
                   Exit For
                      End If
                    Next
      
                  For Each c In myRange
                        If c.Value = "mc smaltiti" Then
                           Here = c.Cells.Address
                           ' MsgBox c.Cells.Column
                           dopocolonnadopo = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
                  Exit For
                        End If
                    Next
                    For Each c In myRange
                        If c.Value = "DATA" Then
                           Here = c.Cells.Address
                           ' MsgBox c.Cells.Column
                           MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
                    Exit For
                        End If
                    Next
    
    End With
  
  
                n = Foglio.Cells(48, c.Cells.Column).End(xlUp).Row
                         
                         For n = 1 To n - 12
                             Foglio.Range(MyColumn & n + 12).Copy .Range("a" & Riga_Tot)
                             Foglio.Range(dopocolonna & n + 12).Copy .Range("b" & Riga_Tot)
                             Foglio.Range(dopocolonnadopo & n + 12).Copy .Range("c" & Riga_Tot)
                             Foglio.Range(MyColumn & 3).Copy .Range("d" & Riga_Tot)
                             Foglio.Range(MyColumn & 2).Copy .Range("e" & Riga_Tot)
                             Riga_Tot = Riga_Tot + 1
                        Next
       
       
        
        'Incrementa la variabile di una unità per testare la cella successiva.
        d = d + 8
    Wend
        End If
        
         
                 
Next Foglio
 
          
wk1.Save


End With
'Application.OnTime Now + TimeValue("00:01:00"), " Recap"
End Sub

di lepat (utente non iscritto) data: 25/01/2015 18:26:18
non ho capito bene il tuo obiettivo, allega un file con anche il foglio riassunto compilato
Ciclo condizionato con macro excel
di gavasato (utente non iscritto) data: 25/01/2015 20:45:58
Ciao. Troverai allegato il file che ho inviato.
Quello che devo fare è copiare i dati di tutti i fogli delle colonne A,B eC in un foglio chiamato Riassunto. La difficoltà risiede nel fatto che le colonne dei vari fogli sono variabili in numero e posizione.

Vuoi Approfondire?