Codice uguale per articoli diversi

Versione Completa Stampa Cerca Utenti Iscriviti Condividi :

Excel Forum » Excel Forum » » Soluzioni Excel Domande e Risposte

Simone Carrieri

00martedì 14 giugno 2016 18:59

Salve,

Devo completare un lavoro su excel ma non so come fare [SM=g27833]

. Praticamente io ho una tabella di valori di questo genere: Foto1
e vorrei fare in modo che l' articolo nella colonna A si ripeta solo una volta e quelli della colonna B seguano sulla stessa riga di A (così: Foto2
Esiste un modo per non doverlo fare a mano? (sono più di 5000 articoli [SM=g27833]

)

Grazie per l'aiuto!

patel45

00martedì 14 giugno 2016 19:13

allega un file excel (no immagine) di esempio con i dati ed il risultato desiderato

Simone Carrieri

00martedì 14 giugno 2016 19:20

Ecco un esempio, scusa se ho usato libre office, ma a casa non ho excel [SM=g27812]

patel45

00martedì 14 giugno 2016 20:52

e vorrei fare in modo che l' articolo nella colonna A si ripeta solo una volta e quelli della colonna B seguano sulla stessa riga di A

nell'esempio non c'è solo la colonna B, per 2 colonne la macro è questa

Sub a()
LR = Cells(Rows.Count, "A").End(xlUp).Row
rini = 2
num = Cells(rini, 1).Value
poli = Cells(rini, 2).Value
destrow = rini
icol = 4: col = icol + 1
Cells(destrow, icol).Value = num
Cells(destrow, col).Value = poli
For j = rini + 1 To LR
  If num = Cells(j, 1).Value Then
    col = col + 1
    If col > 9 Then Exit For
    Cells(destrow, col).Value = Cells(j, 2).Value
  Else
    num = Cells(j, 1).Value
    destrow = destrow + 1
    icol = 4: col = icol + 1
    Cells(destrow, icol).Value = Cells(j, 1).Value
    Cells(destrow, col).Value = Cells(j, 2).Value
  End If
Next
End Sub

Simone Carrieri

00martedì 14 giugno 2016 20:57

si ma poi il procedimento lo applicherò anche alle altre colonne [SM=g27823]

mi serve sono l' imput [SM=g27835]

patel45

00mercoledì 15 giugno 2016 07:43

prova questa

Sub a()
LR = Cells(Rows.Count, "A").End(xlUp).Row
rini = 2
num = Cells(rini, 1).Value
poli = Cells(rini, 2).Value
destrow = rini
icol = 6: col = icol + 1
Cells(destrow, icol).Value = num
For c = 2 To 4
  If Cells(rini, c).Value <> "" Then
     Cells(destrow, col).Value = Cells(rini, c).Value
     col = col + 1
  End If
Next

For j = rini + 1 To LR
  If num = Cells(j, 1).Value Then
    For c = 2 To 4
      If Cells(j, c).Value <> "" Then
        Cells(destrow, col).Value = Cells(j, c).Value
        col = col + 1
      End If
    Next
  Else
    num = Cells(j, 1).Value
    destrow = destrow + 1
    icol = 6: col = icol + 1
    Cells(destrow, icol).Value = Cells(j, 1).Value
    If num = Cells(j, 1).Value Then
      For c = 2 To 4
        If Cells(j, c).Value <> "" Then
          Cells(destrow, col).Value = Cells(j, c).Value
          col = col + 1
        End If
      Next
    End If
  End If
Next
End Sub

Questa è la versione 'lo-fi' del Forum Per visualizzare la versione completa clicca qui
Tutti gli orari sono GMT+01:00. Adesso sono le 12:11.