[Excel Vba] Ciclo ColumnsRowsCount

[Black.Jack]

Ciao a tutti,


stavolta in Excel non riesco ad utilizzare un ciclo agganciato a Columns.Count


Spiegazione esemplificativa:

a 34 56

b 45 67


io vorrei ottenere:

a 34

a 56

b 45

b 67



Volevo usare una formila del tipo
[list=]Sub EsplodiOrizzontale()

Dim Scatola As String


foglio = "Foglio2"
conteggio = "Foglio3"
Worksheets(conteggio).Range("A:C").ClearContents
riga = Worksheets(foglio).Range("A" & Rows.Count).End(xlUp).Row
riga2 = Worksheets(conteggio).Range("A" & Rows.Count).End(xlUp).Row

cellapiena = Range(1, Columns.Count).End(xlLeft).Columns

celladariempire = Column.Count.End(xlLeft).Columns

Sheets(foglio).Select

Cells(riga, cellapiena) = Scatola


Sheets(conteggio).Select

Cells(riga2, celladariempire) = Scatola



End Sub[/list]


Notare che è FORTEMENTE ABBOZZATA...ma i comani columns legati a range...non vuole digerirli perchè non conosco la sintassi o i valori corretti...solitamente ho sempre usato il rows.count...legato alla particella end(xlup)....e ci ho sempre lavorato bene....

Help!

[Black.Jack]

Ovviamente nel titolo intendevo...

Ciclo...con Columns.Count (senza row...intendevo un ciclo che li comprendesse entrambe..)

[Black.Jack]

...procedendo da solo....cerco di andare passo passo partendo dalla prima cella

[list=]Sub EsplodiOrizzontale()

Dim Scatola As String
Dim cellapiena As String


foglio = "Foglio2"
conteggio = "Foglio3"
Worksheets(conteggio).Range("A:C").ClearContents
riga = Worksheets(foglio).Range("A" & Rows.Count).End(xlUp).Row
riga2 = Worksheets(conteggio).Range("A" & Rows.Count).End(xlUp).Row

cellapiena = Worksheets(foglio).Range("A" & Columns.Count).End(xlUp)
celladariempire = Worksheets(conteggio).Range("A" & Columns.Count).End(xlUp)

Sheets(foglio).Select

Scatola = Cells(riga, cellapiena)


Sheets(conteggio).Select

Cells(riga2, celladariempire) = Scatola



End Sub[/list]

[Black.Jack]

Niente...di nuovo

Sub EsplodiOrizzontale()

Dim Scatola As String
Dim Aggiunta As String

foglio = "Foglio2"
conteggio = "Foglio3"
Worksheets(conteggio).Range("A:C").ClearContents
riga = Worksheets(foglio).Range("A" & Rows.Count).End(xlUp).Row
riga2 = Worksheets(conteggio).Range("A" & Rows.Count).End(xlUp).Row

cellapiena = Worksheets(foglio).Range("B" & Columns.Count).End(xlUp)

Sheets(foglio).Select

Scatola = Cells(riga, 1)

If cellapiena <> "" Then

Sheets(conteggio).Select

Cells(riga2, 1) = Scatola
Cells(riga2, 1) = cellapiena
cellapiena = cellapiena + 1

Sheets(foglio).Select

End If

End Sub

[ricky53]

Ciao,
prova con questa macro

Codice: Seleziona tutto

Option Explicit
Public Riga As Long, Colonna As Long, CC As Long, RR As Long, I As Long

Sub Dati_da_Orizzontale_a_Vericale()
    Application.ScreenUpdating = False
' I dati sono sul "Foglio1" ed iniziano dalla colonna "A" e dalla riga "2"
    Foglio1.Select
    CC = Range(Cells(1, 1), Cells(1, Columns.Count)).End(xlToRight).Column
    RR = Range("A" & Rows.Count).End(xlUp).Row
   
' Vengono cancellati tutti i dati del "Foglio2" colonne "A"  e  "B"
    Foglio2.Select
    Columns("A:B").ClearContents
    [A1].Select

' I dati vengono scritti nel "Foglio2" dalla colonna "A" e dalla riga "2"
    I = 2
    For Riga = 2 To RR
        For Colonna = 2 To CC
            Foglio2.Cells(I, 1) = Foglio1.Cells(Riga, 1)
            Foglio2.Cells(I, 2) = Foglio1.Cells(Riga, Colonna)
            I = I + 1
        Next Colonna
    Next Riga
    Application.ScreenUpdating = True
    MsgBox " Elaborazione Effettuata"
End Sub

Leggi i commenti che ho scritto nella macro.

Ciao da Ricky53

[ricky53]

Ciao,

prima ti ho scritto una cosa che non è del tutto corretta anche se, comunque, funzionava:

sostituisci quanto scritto prima sul calclolo di "CC"
ossia

CC = Range(Cells(1, 1), Cells(1, Columns.Count)).End(xlToRight).Column

con

Codice: Seleziona tutto

    CC = Range("A1").End(xlToRight).Column

Ciao da Ricky53

[Black.Jack]

La tua macro è stata preziosissima, e la tengo (come tutte quelle che mi propongono i veterani) da parte per studiare le funzioni che non conosco.

Io ho deciso di usare i miei mezzi comunque ed ho creato questa...molto meno elegante

Codice: Seleziona tutto

Sub Macro()

Dim Scatola As String


foglio = "Foglio2"
conteggio = "Foglio3"
Worksheets(conteggio).Range("A:C").ClearContents
riga = Worksheets(foglio).Range("A" & Rows.Count).End(xlUp).Row
riga2 = Worksheets(conteggio).Range("A" & Rows.Count).End(xlUp).Row
UR = Worksheets(foglio).Rows.Count

contacolonna = Worksheets(foglio).Range("A1").End(xlToLeft).Column

Esplodi = contacolonna + 1

For gotoahahahgiando = 1 To Rows.Count Step 1

Sheets(foglio).Select

dataesplodi = Cells(riga, Esplodi)

If riga = 0 Then Exit Sub

If dataesplodi = "" Then

riga = riga - 1
contacolonna = Worksheets(foglio).Range("A1").End(xlToLeft).Column
Esplodi = contacolonna + 1

End If

If dataesplodi <> "" Then

Scatola = Cells(riga, contacolonna)

Sheets(conteggio).Select

Cells(riga2, 1) = Scatola
Cells(riga2, 2) = dataesplodi
Esplodi = Esplodi + 1
riga2 = riga2 + 1

End If

Next

End Sub


Purtroppo termina in errore quando scala la riga fino ad arrivare a sottrarre "0"....

[Black.Jack]

che stupido che sono...correzione x evitare errore:

Codice: Seleziona tutto

Sub Macro()

Dim Scatola As String


foglio = "Foglio2"
conteggio = "Foglio3"
Worksheets(conteggio).Range("A:C").ClearContents
riga = Worksheets(foglio).Range("A" & Rows.Count).End(xlUp).Row
riga2 = Worksheets(conteggio).Range("A" & Rows.Count).End(xlUp).Row
UR = Worksheets(foglio).Rows.Count

contacolonna = Worksheets(foglio).Range("A1").End(xlToLeft).Column

Esplodi = contacolonna + 1

For gotoahahahgiando = 1 To Rows.Count Step 1

Sheets(foglio).Select

dataesplodi = Cells(riga, Esplodi)



If dataesplodi = "" Then

riga = riga - 1
contacolonna = Worksheets(foglio).Range("A1").End(xlToLeft).Column
Esplodi = contacolonna + 1

End If

If dataesplodi <> "" Then

Scatola = Cells(riga, contacolonna)

Sheets(conteggio).Select

Cells(riga2, 1) = Scatola
Cells(riga2, 2) = dataesplodi
Esplodi = Esplodi + 1
riga2 = riga2 + 1

End If

If riga = 0 Then Exit Sub

Next

End Sub