salto

Hai un problema con Excel?

Nuova discussione

salto
di giro88 (utente non iscritto) data: 09/02/2014 21:06:32
Ciao! Ho bisogno di una mano!.. allego file di esempio.. come potete vedere ho 3 colonne codice nome e peso. quello che devo fare e di identificare il primo codice di ogni macchina in questione e portare il peso ad 1.01 nel primo giro e poi lanciare un'altra macro che nel mio caso si chiama start. successivamente riportarlo ad 1.0 e trovare i secondi codici di ogni macchina (Se presenti) e portarli ad 1.01 e così via. Cred che la soluzione potrebbe essere una macro che mi estragga singolarmente i nomi delle macchine e mi conti quanti diversi codici ha. dopo andare a inserire questi codici in un vettero e magari legarli ad una variabile booleana che mi dica se questo è stato già portato a 1.01 in precedenza o meno. Potreste aiutarmi/darmi qualche consiglio?? graziee millee!!
di Zer0Kelvin data: 10/02/2014 04:05:03
Ciao.

Cit:**poi lanciare un'altra macro che nel mio caso si chiama start**
Non vedo nessuna macro nel file
La spiegazione è un pò ingarbugliata, puoi provare a ridescrivere il quesito? magari indicando passo passo le operazioni che vorresti automatizzare.

PS: perchè il titolo del post è salto? sembra non entrarci per nulla col problema.
di giro88 (utente non iscritto) data: 10/02/2014 08:19:30
Ciao.. Hai ragione è scritto con i piedi..
Il titolo non è molto esaustivo.. Pensavo al salto dato che porto da 1 a 1.01 i pesi.. Non ho molta fantasia :)..

La macro start è lanciata aprendo un altro foglio di lavoro.. Fa un semplicr calcolo..prende i pesi di ogni codice di macchina li moltiplica per il prezzo.. Tutto qua.. Ma non mi interessa al momento..

Operazioni che desidero:
1. Trovo il primo codice di ogni macchina e lo porto ad 1.01..e parte start
2. Riporto i pesi ad 1.00
3. Trovo i secondi codici presenti in lista per ogni singola macchina.. Li porto ad 1.01 ecc..

Lo so non è semplicissimo il concetto.. Spero di essere stato chiaro
di Vecchio Frac data: 10/02/2014 09:37:58
Ma in pratica devi creare, affiancandole, una serie di tabelle uguali delle macchine: nella prima tabella le prime occorrenze dei codici sono settati a 1.01, nella seconda tabella le seconde occorrenze dei codici sono settati a 1,01 e vengono riportati a 1,00 i primi; eccetera. Alla fine avrai tot tabelle uguali affiancate dove per ogni codice in sequenza è impostato il valore 1,01.
Giusto o sbagliato?
Altrimenti: tra una serie e l'altra, devi eseguire altre operazioni prima di resettare tutto e ripartire con le seconde, terze, quarte occorrenze dei codici macchina?
di giro88 (utente non iscritto) data: 10/02/2014 09:55:10
Esatta la seconda soluzione! Non mi serve creare tante tabelle.. Nel file di esempio le avevo fatte per cercare di spiegarvi al meglio cosa dovevo fare. Il risultato viene salvato dall'altra macro che eseguo. l'importante è solo portare quel peso a 1.01 per tutti i primi codici trovati in lista di ogni singola macchina. eseguo l'altra macro.. e poi resetto.. secondo ciclo controllo se non avevo già saltato quel peso ad 1.01 e stesso giro. Per questo pensavo ad un arrey booleano che mi dica true se il peso è stato gia' portato in precedenza ad 1.01 quindi non dovrei più aumentarlo in un secondo giro
di Zer0Kelvin data: 10/02/2014 10:40:29
Adesso mi senbra più chiaro, vediamo se ho capito bene; riferiamoci per semplicità a una sola macchina:
codice Nome peso
codice 1 Macchina TZF99 1,00
codice 2 Macchina TZF99 1,00
....................................
codice n Macchina TZF99 1,00

1)Imposto a 1.1 il peso di codice 1
2)Lancio al macro start
3)Reimposto a 1 il peso di codice 1

1)Imposto a 1.1 il peso di codice 2
2)Lancio al macro start
3)Reimposto a 1 il peso di codice 2

e ripeto n volte (dove n è il numero massimo di codici per ciascuna macchina) i punti 1) 2) e 3)

Cominciamo a risolvere questo, poi vediamo...
di giro88 (utente non iscritto) data: 10/02/2014 11:05:30
Esattamente!!Grandissimo.. Purtroppo come avrai capito non è molto semplice da spiegare a parole :) Grazie mille
di Vecchio Frac data: 10/02/2014 11:41:39
In fondo basterà riordinare per nome macchina e ciclare per ogni elemento fino al successivo elemento "diverso".
Naturalmente quando avremo macchine con un solo elemento rispetto a macchine con più elementi (e quindi con più passate), dopo la prima passata quello non verrà più interessato dall'aggiornamento del peso.
di Zer0Kelvin data: 10/02/2014 12:22:35
Più che giusto!
Potendo riordinare la lista per nome macchina il codice dalla macro sarà molto più semplice.
di giro88 (utente non iscritto) data: 10/02/2014 15:17:39
si nessun problema al riordine! Grazie ragazzi
di giro88 (utente non iscritto) data: 10/02/2014 19:19:54
Niente da fare :).. ci sto provando ma non ho ancora una soluzione.. :(
di Vecchio Frac data: 10/02/2014 21:37:07
Hai scritto qualche riga di codice da mostrare?

di giro88 (utente non iscritto) data: 10/02/2014 23:34:40
Posto queste due righe di codice.. Ovviamente non gira :)

Sub salto()
    Dim rg(), remdupl()
    Dim conta As Integer
    conta = Application.WorksheetFunction.CountA(Worksheets(1).Range("A2:A1000"))
    ReDim rg(1 To conta, 1 To 3)
    
    For i = 1 To conta
        rg(i, 1) = Worksheets(1).Range("A" & i + 2).Value
        rg(i, 2) = Worksheets(1).Range("B" & i + 2)
        rg(i, 3) = "FALSE"
    Next i
    
    remdupl = Worksheets(1).Range("B3:B" & conta + 1).Value
    Worksheets(1).Range("Q2:Q" & conta) = remdupl
    Worksheets(1).Range("Q2:Q" & conta).RemoveDuplicates Columns:=1, Header:=xlNo
    
    For jj = 1 To Application.WorksheetFunction.CountA(Worksheets(1).Range("Q2:Q1000"))
        Worksheets(1).Range("R" & jj + 1) = Application.WorksheetFunction.CountIf(Worksheets(1).Range("B3:B" & conta), Worksheets(1).Range("Q" & jj + 1))
    Next jj
    
    Dim rgs
    ReDim rgs(1 To Application.WorksheetFunction.CountA("Q2:Q1000"), 1 To 2)
    
    contaremdupl = Application.WorksheetFunction.CountA(Worksheets(1).Range("Q2:Q1000")) + 1
    rgs = Worksheets(1).Range("Q2:R" & contaremdupl + 1)
    
    For mm = 1 To conta
        For jj = 1 To contaremdupl
            If rgs(jj, 1) = rg(mm, 2) And rgs(jj, 1) > 0 And rg(mm, 3) = "FALSE" Then
                Worksheets(1).Range("C" & mm + 2) = "1.01"
                'Application.Run "Start"
                rg(mm, 3) = "TRUE"
                rgs(jj, 2) = rgs(jj, 2) - 1
            End If
        Next jj
            
    Next mm
            Worksheets(1).Cells(3, 3) = "1.00"
            Worksheets(1).Cells(3, 3).AutoFill Destination:=Range("C3:C26")
         
End Sub

di giro88 (utente non iscritto) data: 11/02/2014 09:37:09
OK! Attualmente questa roba sembrerebbe gira.. è scritta male e sicuramente ottimizzabile.. Date uno sguardo please!

Sub salto()
    Dim rg(), remdupl()
    Dim conta As Integer
    conta = Application.WorksheetFunction.CountA(Worksheets(1).Range("A2:A1000"))
    ReDim rg(1 To conta, 1 To 3)
    
    For i = 1 To conta
        rg(i, 1) = Worksheets(1).Range("A" & i + 1).Value
        rg(i, 2) = Worksheets(1).Range("B" & i + 1)
        rg(i, 3) = "FALSE"
    Next i
    
    remdupl = Worksheets(1).Range("B3:B" & conta + 1).Value
    Worksheets(1).Range("Q2:Q" & conta) = remdupl
    Worksheets(1).Range("Q2:Q" & conta).RemoveDuplicates Columns:=1, Header:=xlNo
    
    For jj = 1 To Application.WorksheetFunction.CountA(Worksheets(1).Range("Q2:Q1000"))
        Worksheets(1).Range("R" & jj + 1) = Application.WorksheetFunction.CountIf(Worksheets(1).Range("B3:B" & conta), Worksheets(1).Range("Q" & jj + 1))
    Next jj
    
    Dim rgs
    ReDim rgs(1 To Application.WorksheetFunction.CountA("Q2:Q1000"), 1 To 2)
    
    contaremdupl = Application.WorksheetFunction.CountA(Worksheets(1).Range("Q2:Q1000"))
    rgs = Worksheets(1).Range("Q2:R" & contaremdupl + 1)
    
    Dim trovato As Boolean
    Dim maxiter, maxm
    
    maxm = 0
    
    maxiter = Application.WorksheetFunction.Max(Worksheets(1).Range("R2:R10"))
    
    Do While maxm < maxiter
        For mm = 1 To contaremdupl
            trovato = False
            For jj = 1 To conta
                    If rgs(mm, 1) = rg(jj, 2) And rgs(mm, 2) > 0 And rg(jj, 3) = "FALSE" And trovato = False Then
                        Worksheets(1).Range("C" & jj + 1) = "1.01"
                        'Application.Run "Start"
                        rg(jj, 3) = "TRUE"
                        rgs(mm, 2) = rgs(mm, 2) - 1
                        trovato = True
                    End If
            Next jj
        Next mm
         Worksheets(1).Cells(2, 3) = "1.00"
        Worksheets(1).Cells(2, 3).AutoFill Destination:=Range("C2:C26")
        maxm = maxm + 1
    Loop
         
End Sub

di Vecchio Frac data: 11/02/2014 10:31:29
Confesso... non ho guardato il tuo codice.
Ho scritto questo, che pure mi sembra corretto, fai qualche test.
Passo preliminare: seleziona la tabella dei dati compresa l'intestazione di riga e attribuiscile il nome "tabella". Il codice è abbastanza furbo da riferirsi a tale tabella dovunque essa sia posizionata nel foglio.
Comunque ho cercato di commentare nel modo più chiaro possibile.
C'è un trucchetto interessante che, se vuoi, possiamo ridiscutere :) e comunque ti rimane una colonna d'appoggio che poi va cancellata.

Option Explicit

Sub salto_vfrac()
Dim ac As Range, macchina_precedente As String, macchina_attuale As Range
Dim last_row As Integer, start_row As Integer, output_column As Integer
Dim nome_macchina_column As Integer
Dim i As Integer
Dim c As Range, first_found As String

    [tabella].Sort key1:=Range([tabella].Cells(1, 2).Address), order1:=xlAscending, header:=xlYes
    
    start_row = [tabella].Cells(2, 1).Row               'riga Excel in cui inizia la tabella
    last_row = start_row + [tabella].Rows.Count - 2     'riga Excel in cui finisce la tabella: bisogna tener conto dell'intestazione
    nome_macchina_column = [tabella].Columns(2).Column  'numero della colonna Excel con i nomi macchina
    output_column = [tabella].Columns(4).Column         'numero della prima colonna Excel libera a destra della tabella, esterna, dove depositare i valori
    
    With Cells(start_row, output_column).Resize(last_row - start_row + 1)
        '.Formula = "=IF(R[-1]C[-2]=RC[-2],R[-1]C,R[-1]C+1)"        'raggruppa blocchi di valori uguali assegnando numero uguale
        .Formula = "=IF(R[-1]C[-2]=RC[-2],R[-1]C+1,1)"              'raggruppa blocchi uguali assegnando un progressivo da 1"
        .Value = .Value
    End With


    For i = 1 To Application.Max(Columns(output_column))
        With Range([tabella].Cells(start_row - 1, 4), [tabella].Cells(last_row, 4))   'cerca nella colonna di appoggio dei numeri progressivi
            Set c = .Find(i, LookIn:=xlValues, LookAt:=xlWhole)     'rintraccia tutti i numeri progressivi da 1 in poi
            first_found = c.Address
            Do
                c.Offset(, -1).Value = 1.01     'imposta il peso a 1,01
                Set c = .FindNext(c)    'cerca il prossimo progressivo uguale
            Loop While Not c Is Nothing And c.Address <> first_found
            
            'call Start     'richiama la macro "start"
            MsgBox "Giro completato, azzeramento"
        End With
        
        Range(Cells(start_row, [tabella].Columns(3).Column), Cells(last_row, [tabella].Columns(3).Column)) = 1      'azzera i pesi portandoli a 1,00
    Next
    
    MsgBox "Fine della procedura."
    
End Sub

di ZerOkelvin (utente non iscritto) data: 11/02/2014 12:45:24
Tanto per rimanere in tema di codici che "non girano" ho scritto il codice seguente, che però non funziona come dovrebbe (esegue 29 cicli con i dati di esempio).
Se qualcuno (a tempo "veramente" perso) fosse così gentile da darci un'occhiata e dirmi dov'è l'errore (o errori) avrebbe la mia eterna gratitudine

Sub Ciclo()
Dim sh As Worksheet
Dim LR As Long, Ciclo As Long, rigaMacchina As Long, rigaAttuale As Long
Dim Finito As Boolean
    Set sh = ThisWorkbook.Sheets("Foglio1")
    With sh
        LR = .Range("B" & .Rows.Count).End(xlUp).Row
        With .Sort ' ordino il range interessato in base alla colonna "B"
            .SortFields.Clear
            .SortFields.Add sh.Range("B3")
            .SetRange sh.Range("A3:C" & LR)
            .Apply
        End With
        Ciclo = 1
        Range("Q:Q").ClearContents
        Do
            rigaMacchina = 3
            Finito = True
            While rigaMacchina < LR
                rigaAttuale = rigaMacchina
                If .Cells(rigaMacchina, 3).Value = .Cells(rigaMacchina + Ciclo - 1, 3).Value Then
                    .Cells(rigaMacchina + Ciclo - 1, 3).Value = 1.1
                    Finito = False
                End If
                While .Cells(rigaMacchina, 2).Value = .Cells(rigaAttuale, 2).Value 'passa alla prossima macchina
                    rigaMacchina = rigaMacchina + 1
                Wend
            Wend
            'Esegui le operazioni per questo ciclo
            .Range("Q" & Ciclo).Value = "Ciclo " & Ciclo & " completato."
            .Range("C3:C" & LR).Value = 1 'reimposta a 1 tutti i pesi
            Ciclo = Ciclo + 1 'passa al ciclo successivo
        Loop Until Finito
    End With
    Set sh = Nothing
End Sub

di scossa data: 11/02/2014 13:23:40
cit. Vecchio Frac: "Ho scritto questo, che pure mi sembra corretto, fai qualche test."

Solo un'osservazione di carattere generale (non ho analizzato il codice a fondo, che comunque mi pare funzioni correttamente): io eviterei gli orfani:
....
With Cells(start_row, output_column).Resize(last_row - start_row + 1)
......
Range(Cells(start_row, [tabella].Columns(3).Column), Cells(last_row, [tabella].Columns(3).Column)) = 1

Quei Cells() e Range() sarbbe meglio avessero un padre, ad esempio con un bel:

Dim ws as worksheet
....
Set ws = [tabella].parent
....
With ws.Cells(start_row, output_column).Resize(last_row - start_row + 1)
....
ws.Range(ws.Cells(start_row, [tabella].Columns(3).Column), ws.Cells(last_row, [tabella].Columns(3).Column)) = 1

di scossa data: 11/02/2014 13:39:25
Dimenticavo .... alla fine un bel Set ws = Nothing
di scossa data: 11/02/2014 13:51:55
cit. zerokelvin: "ho scritto il codice seguente, che però non funziona come dovrebbe (esegue 29 cicli con i dati di esempio). "

A me (incollando il tuo codice nel file che c'è qui) ne registra 25 ........ ma non ancora non ho capito lo scopo del gioco, forse perché non so cosa sia la macro Start
di Vecchio Frac data: 11/02/2014 14:08:26
Ciao scossa,
ho ritenuto superfluo nel mio codice qualificare celle e range(s), non avendo attivato altri fogli che quello che contiene la [tabella]. Se però risulta più funzionale, anche per la comprensione, allora certamente male non gli fa :)

Anche a me il codice di zerokelvin fa 25 passate, ma ci sono alcune ridondanze (il codice macchina singolo viene ripassato più volte mentre dovrebbero essere solo 24 senza ripassi), non ho scoperto il baco.

La macro Start non è stata (ancora) definita, deve essere avviata ad ogni passaggio prima del passaggio successivo. In pratica bisogna impostare a 1,01 ogni codice macchina in sequenza per ordine di apparizione (prima tutte le prime ricorrenze di ogni singolo codice, poi tutte le seconde, poi le terze, ecc. se ce ne sono e finchè ce ne sono). Ad ogni passaggio (impostata cioè la prima sequenza di 1,01) si lancia la macro Start (ancora indefinita), quindi si reimpostano tutti i valori a 1,00.
Un po' contorto ma chiaro :)
di giro88 (utente non iscritto) data: 11/02/2014 15:13:26
Ciao a tutti ragazzi! Concordo la "macro start" in realtà è una funzione che è di un addin mio di excel.. per questo è rimasta fin ora indefinita. Ringrazio tutti per la disponibilità veramente mi siete di grande aiuto. L'unica cosa che vorrei sollevare. Il range non posso definirlo inizialmente come richiesto dal Vecchio Frac.. perchè la numerosità della tabella non la conosco a priori. Grazie ancora!!

di scossa data: 11/02/2014 15:23:50
cit. VF: "C'è un trucchetto interessante che, se vuoi, possiamo ridiscutere :) "

Mi è piaciuta la tua soluzione, mi sono solo permesso di semplificare un po' il codice per renderlo più leggibile (almeno per me):

Sub salto_vfrac()
  
  Dim i As Long
  Dim c As Range, first_found As String
  Dim rngPesi As Range
  Dim rngOut As Range
  
  [tabella].Sort key1:=Range([tabella].Cells(1, 2).Address), order1:=xlAscending, Header:=xlYes
 
  Set rngPesi = Intersect([tabella], [tabella].Columns(3).Offset(1))
  Set rngOut = rngPesi.Offset(0, 1)
  With rngOut
    .Formula = "=IF(R[-1]C[-2]=RC[-2],R[-1]C+1,1)"              'raggruppa blocchi uguali assegnando un progressivo da 1"
    .Value = .Value
  End With


  For i = 1 To Application.Max(rngOut)
      With rngOut   'cerca nella colonna di appoggio dei numeri progressivi
          Set c = .Find(i, LookIn:=xlValues, LookAt:=xlWhole)     'rintraccia tutti i numeri progressivi da 1 in poi
          first_found = c.Address
          Do
              c.Offset(, -1).Value = 1.01     'imposta il peso a 1,01
              Set c = .FindNext(c)    'cerca il prossimo progressivo uguale
          Loop While Not c Is Nothing And c.Address <> first_found
          
          'call Start     'richiama la macro "start"
          MsgBox "Giro " & i & " completato, azzeramento"
      End With
      
      rngPesi = 1      'azzera i pesi portandoli a 1,00
  Next
  rngOut.Clear
  Set rngPesi = Nothing
  Set rngOut = Nothing
  MsgBox "Fine della procedura."
End Sub

di Vecchio Frac data: 11/02/2014 15:34:17
cit. scossa: "almeno per me"
---> Ma anche soprattutto per me ^_^
Molto più elegante, grazie.

cit. giro88: "Il range non posso definirlo inizialmente come richiesto dal Vecchio Frac.. perchè la numerosità della tabella non la conosco a priori."
---> Ma vedi che ti conviene definire la tabella in quel modo. Se non ne conosci a priori le dimensioni, le ricavi in fase di esecuzione con CurrentRegion.
di giro88 (utente non iscritto) data: 11/02/2014 22:57:06
Grandissimi Ragazzi! Provo tutti i codici e vi aggiorno.. Comunque veramente grazie epr la disponibilità
di giro88 (utente non iscritto) data: 12/02/2014 20:01:36
Ho fatto girare tutti i codici.. Ho dovuto fare dei piccoli aggiustamenti per il mio caso.. ma sono perfetti!! :D Grandissimi.. Devo chiedervi però un'altra cortesia che ho riscontrato oggi. Quella fantomatica funzione start mi fa dei calcoli con quei pesi e mi scrive nello sheet2 in riga da G5 a N5 ..su ogni riga ho il nome della macchina nella collonna G. quello che vorrei aggiungere adesso è che ad ogni giro questi portati a 1.01 vado a cercarli per nomemacchina nello sheet2 in colonnaG e mi estraggo questo range da Gi a Ni e lo metto nello sheet3. Lo so è un delirio. vedo però che nel codice viene usato il find e address potrebbe essermi utile? E' fattibile?

Vuoi Approfondire?