riordino condizionale di una lista



  • riordino condizionale di una lista di Bering (utente non iscritto) data: 17/12/2016 15:27:24

    Ciao a tutti,

    cerco di spiegare il problema:

    ho una macro che rinomina una lista di files in una cartella in base al risultato di certe formule.

    La macro crea la lista dei nomi di tutti i file nella cartella e li inserisce in un file excel, Sheet1 in colonna B.

    Nello stesso file excel, in Sheet2, colonna B, una formula riprende la stessa lista e in colonna C, altre formule (molto piu' complesse di quelle nel mio file d'esempio) servono a rinominare i file. Fin qui tutto ok.

    Il problema e' che la lista nel sheet2 e' statica e quindi se l'ordine dei files nella cartella d'origine cambia, i files vengono rinominati incorrettamente.
    Nel file d'esempio, il risultato voluto è nel range G1 H4.

    Per risolvere il problema abbiamo aggiunto un check nello Sheet 1 (colonna H) che ci consente di riordinare manualmente la lista di files prima di rinominarli.

    La mia domanda e': esiste un modo per evitare questo riordino manuale? Tipo una macro che prova le varie combinazioni fino a che tutte le formula nella colonna H mostano "TRUE"..... In realta' i files da rinominare sono molti di piu' dei 4 che ho inserito nel mio esempio, quindi sarebbe davvero un risparmio di tempo.

    Grazie!!!




  • riordino condizionale di una lista update di Bering (utente non iscritto) data: 17/12/2016 23:11:18

    Ecco cosa sono riuscito a fare fino ad ora.... ovviamente non funziona!

    Le 2 array contengono gli elementi giusti, purtroppo pero' non riesco a fare il loop tra gli elementi delle 2 array in modo corretto.

    Forse dovrei usare un Do until?

    Se qualcuno avesse la pazienza di dare uno sguardo al mio file e al codice che ho provato a scrivere e volesse darmi qualche spunto da cui partire sarei davvero grato.

    Grazie!

     
    Option Explicit
    Sub Test()
        Dim strNames(4) As String
        Dim strNames2(4) As String
        Dim lElement As Long
        Dim lElement2 As Long
        Dim rCell As Range
        Dim item As Variant
        Dim item2 As Variant
        
       For Each rCell In Range("H1:H4")
    
        If rCell.Value = "False" Then
        
        
            
            strNames(lElement) = rCell.Row
            strNames2(lElement2) = Cells(rCell.Row, 2).Value
           
            lElement = lElement + 1
            lElement2 = lElement2 + 1
        End If
    
        Next rCell
    '    MsgBox (Join(strNames, " "))
    '    MsgBox (Join(strNames2, " "))
    
      For Each rCell In Range("H1:H4")
      
        
                    For Each item In strNames
                    For Each item2 In strNames2
        
                       Cells(item, 2) = item2
                       
                    Next item2
                    Next item
                    
                    
                    If rCell.Value <> "True" Then
                    End If
                            
           
        Next rCell
    End Sub


  • di patel data: 18/12/2016 08:40:26

    credo che dovresti spiegare meglio cosa vuoi ottenere, io non ho capito niente.


  • di Bering (utente non iscritto) data: 18/12/2016 11:05:33

    Il mio obiettivo è ottenere true in tutte le 4 celle della colonna H dello sheet1 in modo automatico. Nel mio file d'esempio si tratta di invertire di posto le 2 celle B3 e B4, ma in realtà ci sono molte più celle da riordinare.
    Solo questo.

    Grazie Patel.


  • di Bering (utente non iscritto) data: 18/12/2016 15:05:51

    ok, dopo innumerevoli tentativi ho finalmente risolto.

    Posto il codice nel caso in cui interessi a qualcuno.

    Grazie comunque.
     
    Option Explicit
    
    Sub RearrangeList()
        Dim strNames() As String
        Dim strNames2() As String
        Dim lElement As Long
        Dim lElement2 As Long
        Dim rCell As Range
        Dim item As Variant
        Dim item2 As Variant
        Dim LastRow As Integer
        Dim sht As Range
        
        On Error Resume Next
        
    
         LastRow = Range("B" & Rows.Count).End(xlUp).Row
         
         ReDim Preserve strNames(0 To LastRow)
         ReDim Preserve strNames2(0 To LastRow)
         
           For Each rCell In Range("H1:H" & LastRow)
        
                If rCell.Value = "False" Then
                    strNames(lElement) = rCell.Row
                    strNames2(lElement2) = Cells(rCell.Row, 2).Value
                   
                    lElement = lElement + 1
                    lElement2 = lElement2 + 1
                End If
        
            Next rCell
     
        
          For Each item In strNames
            Do
                For Each item2 In strNames2
            
                      Cells(item, 2) = item2
                           
                       If Cells(item, 8) = True Then Exit Do
                       
                Next item2
            Loop
           Next item
        
    End Sub