Macro con pastespecial

Hai un problema con Excel?

Nuova discussione

Macro con pastespecial
di Giuseppe (utente non iscritto) data: 16/03/2009
Ciao a tutti,

sono nuovo del forum e ho poche basi per l'uso di vba.
in pratica ho due fogli, sul primo ho una lista molto lunga di cui in colonna a ho fatto un raggruppamento. in corrispondenza di questo raggruppamento in colonna c ho dei valori che ho bisogno di visualizzare trasposti nel foglio 2. quindi ho messo in colonna a del foglio 2 i singoli raggruppamenti e vorrei utilizzare pastespecial in una macro per vedere i dati della colonna c.foglio1 sulla stessa riga del raggruppamento trasposti.

quello che ho fatto fin'ora è questo:
sub confronta()
for each cella2 in worksheets("foglio2").range("a1:a138")
for each cella1 in worksheets("foglio1").range("a2:a1209")
if cella2.value = cella1.value then
cella1.range("c2").copy
cella2.range("b2").pastespecial paste:=xlpasteall, operation:=xlnone, skipblanks:= _
true, transpose:=true
end if
next
next
end sub

la macro funziona ma sovrascrive i dati della colonna c sulle celle della colonna b.foglio2.

c'è un modo per non fargliele sovrascrivere?

grazie in anticipo

giuseppe

di Enzo (utente non iscritto) data: 16/03/2009
Prova questa istruzione si muove cosi' confronta foglio1 colonna a con il contenuto foglio2 colonna a se trova codici uguali scrive il contenuto del foglio1 colonna c nel foglio2 colonna c vicino al codice corrispondente
fa sapere se va bene

conta = Application.WorksheetFunction.CountA(Foglio1.Range("a1:a60000"))
conta2 = Application.WorksheetFunction.CountA(Foglio2.Range("a1:a60000"))
For I = 1 To conta
For H = 1 To conta2
If Foglio1.Range("a" & I).Value = Foglio2.Range("a" & H).Value Then
Foglio2.Range("C" & H).Value = Foglio1.Range("C" & I).Value
End If
Next H
Next I

di Ricky53 data: 17/03/2009
Ciao,
"attenzione"
giuseppe vuole i dati copiati ma "trasposti".

giuseppe dovresti dire con maggiore chiarezza come sono organizzati, sui du efogli, i dat; meglio sarebbe se tu allegassi un file.
ciao da ricky53
di Enzo (utente non iscritto) data: 17/03/2009
Ciao riky scusa la mia ignoranza ma che si intende per trasposti?
di Giuseppe (utente non iscritto) data: 17/03/2009
Intanto grazie mille per le risposte!!

ho provato la macro di enzo ma mi da un errore di sintassi sull'if ho provato a sistemarla ma forse prima mi dovrei mettere seriamente a studiare vb
come devo fare per l'upload del file?
cmq provo a farne una bozza qui sotto...
foglio1
.....a...........................b....
steli abc................3.14.55x
steli abc................3.14.03x
steli abc................vuota
cotili bbc...............3.40.54x
cotili bbc...............vuota
cotili bbc...............55.02.031x
frese acetabolari.....3.14.25x
frese acetabolari.....vuota

nel foglio2 riporto le classi del foglio 1 col a e vorrei qualcosa del tipo:
.....a...........................b.............c..
steli abc...............3.14.55x......3.14.03x....
cotili bbc..............3.40.54x......55.02.031x..
frese acetabolari....3.14.25x.....................

cioè questi codici trasposti sulle righe del foglio 2 in corrispondenza delle classi di appartenenza con l'opzione salta celle vuote attivata..

grazie ancora!!
giuseppe
di Enzo (utente non iscritto) data: 17/03/2009
Ok, ora ho capito cosa si intende per trasposti
di Enzo (utente non iscritto) data: 17/03/2009
No,giuseppe abbandona l'istruzione che ti avevo postato
non serve a nulla con quello che hai chiesto
di Ricky53 data: 17/03/2009
Ciao giuseppe,
per allegare un file utilizza il link, in alto a destra,
"allega un file alla discussione"

occorre un ciclo for/next che scorra le righe e le riporti sulle colonne di una stessa riga.

al momento non ho il tempo di buttare giù uno schema. vedo se posso questa sera.

sarebbe meglio avere, comunque, un file su cui basarsi: il risultato sarà più sicuro (in relazione ai riferimenti di cella, righe e colonne) ed occorrerà meno tempo.

attento ai dati riservati.

sicuramente qualche altro navigante ti aiuterà.

ciao da ricky53

di Enzo (utente non iscritto) data: 17/03/2009
Come ti ha detto giustamente riky bisognerebbe vedere il tuo file
in ogni caso l'istruzione qui sotto dovrebbe servire a qualcosa
prima di tutto salva il file e fai delle prove
l'istruzione si comporta cosi'
prende in blocco il contenuto del foglio e lo copia nel foglio2 riordina per codice e poi dovrebbe fare quello che hai chiesto
vedi un po se va bene
p.s. i dati sono presi in esame senza tener conto se la prima riga e' una intestazione di colonne

Application.ScreenUpdating = False
Sheets("Foglio2").Select
Cells.Select
selection.ClearContents
Range("A1").Select
Sheets("Foglio1").Select
Cells.Select
Selection.Copy
Sheets("Foglio2").Select
    Cells.Select
    ActiveSheet.Paste
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
        Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range("A65536").Select
    Selection.End(xlUp).Select
    riga_fi = ActiveCell.Row
    riga_in = 2
    col_in = 3
    intervallo = "C" & riga_in & "." & "L" & riga_fi
    Range(intervallo).Select
    Selection.ClearContents
    I = col_in
    k = 0
    For j = riga_in To riga_fi
           If Cells(j, 1) = Cells(j + 1, 1) Then
            If k > 0 Then
                Cells(k, I) = Cells(j, 2)
            Else
                Cells(j, I) = Cells(j, 2)
                k = j
            End If
            I = I + 1
        Else
            If Cells(j - 1, 1) = Cells(j, 1) Then
                If k > 0 Then
                    Cells(k, I) = Cells(j, 2)
                    k = 0
                End If
                I = col_in
            End If
        End If
    Next j
If Range("a1").Value = Range("a2").Value And Range("a1").Value <> Range("a3").Value Then
Range("c1").Value = Range("b1").Value
Range("d1").Value = Range("b2").Value
End If
If Range("a1").Value = Range("a2").Value And Range("a1").Value >= Range("a3").Value Then
 Range("C2:AZ2").Select
    Selection.Cut
    Range("D1").Select
    ActiveSheet.Paste
    Range("C1").Value = Range("B1").Value
End If
    Rows("1:1").Select
 Selection.Insert Shift:=xlDown
    Range("A1").Select
    ActiveCell.FormulaR1C1 = 0
    x = Application.WorksheetFunction.CountA(Range("a2:a60000")) + 1
        For I = 2 To x
If Range("a" & I).Value <> Range("a" & I + 1).Value And Range("a" & I).Value <> Range("a" & I - 1).Value Then
Range("c" & I).Value = Range("b" & I).Value
End If
Next I
Rows("1:1").Select
    Selection.Delete Shift:=xlUp
      Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft
CONTA = Application.WorksheetFunction.CountA(Range("a1:a60000"))
For I = 1 To CONTA
Range("B" & I).Select
If Range("B" & I).Value = "" And Range("A" & I).Value <> "" Then
Range("B" & I).EntireRow.Delete
I = I - 1
End If
Next I
Application.ScreenUpdating = True

di Giuseppe (utente non iscritto) data: 17/03/2009
Grazie ancora enzo e ricky!!

ho provato la macro ma non funziona ancora ho provato anche a riguardare cosa fa ma non ci capisco granchè... è bella lunga.. e io che pensavo che in poche righe di codice si risolvesse tutto
adesso carico una tabella di prova così avete davanti il caso pratico...
grazie ancora, e se mi risolvete il problema vi offro... un cocktail dalla lista

giuseppe
di Enzo (utente non iscritto) data: 17/03/2009
Gli daro' un occhiata

Risolto grazie cmq
di Giuseppe (utente non iscritto) data: 17/03/2009
Ciao ragazzi,

dopo tutto non era così difficile ho risolto

grazie cmq

giuseppe

Dim a As Integer
Dim valore1a As String
Dim valore2a As String
Dim valore1b As String
For i = 2 To 136
a = 2
For j = 2 To 1212
valore1a = Worksheets("foglio1").Cells(j, 1).Value
valore2a = Worksheets("foglio2").Cells(i, 1).Value
valore1b = Worksheets("foglio1").Cells(j, 2).Value
If valore1a = valore2a Then
If valore1b <> "" Then
Worksheets("foglio2").Cells(i, a).Value = valore1b
a = a + 1
End If
End If
Next j
Next i

Vuoi Approfondire?