prima riga disponibile

Hai un problema con Excel?

Nuova discussione

prima riga disponibile
di trump61 data: 28/04/2016 11:35:26
Ciao a tutti, sono di nuovo qui. Sto trovando difficoltà nella modifica di un file, lo avevo realizzato usando caselle di testo soltando che quando volevo cancellarne il contenuto a volte e non sono mai riuscito ad ovviare a ciò mi andava in errore, così ho pensato di usare delle celle dimensionate come un piccolo quadrato dove andare ad inserire una X. ho aggiunto alcune righe quindi dovevo modificare un codice che mi prende dei dati da un foglio "Servizio" che sono di questo tipo 2AB- 3AB eccc ognuno in una cella diversa nella stessa riga e me li scompone scrivendoli in un foglio scheda così
B C
2 A
2 B
3 A
3 B
nel vecchio file tutto funzionava perfettamente con questo codice(primo)
ho aggiunto soltanto delle righe ho cambiato il codice così (secondo) mi sembrava semplice ma non funziona più, sicuramente sono io che mi sto perdendo in un bicchiere d'acqua ma non capisco perchè.
allego il file che non funziona ridotto al minimo senza alcune parti che non servirebbero alla discussione.
ho pensato che il problema potesse stare nel fatto che unisco delle celle e da li poi cerco la prima cella vuota dove iniziare ad inserire i miei dati, perchè ho fatto delle prove e se inserisco la riga 30 invece della 31 e usando solo sh1.Cells(30, 1).End(xlDown).Offset(1, 0).Value = "prova" mi scrive prorpio nella prima cella libera nella colonna 2 ho cambiato quindi nel mio codice 31 con 30 ma non funziona e a dire il vero non capisco perchè dovrei mettere la riga 30.
vi ringrazio per un vostro aiuto
allego il file
per motivi estetici ho anche aggiunto un colonna

Sub posiziona2()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Scheda")
Dim sh2 As Worksheet: Set sh2 = Worksheets("Servizio")
Dim D As String
Dim F As Long
For F = 1 To 7
D = Len(sh2.Cells(1, F))
If Right(sh2.Cells(1, F), 2) = "AB" Then
 sh1.Cells(23, 1).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
 sh1.Cells(23, 1).End(xlDown).Offset(0, 1).Value = Mid(sh2.Cells(1, F), D - 1, 1)
 sh1.Cells(23, 1).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
 sh1.Cells(23, 1).End(xlDown).Offset(0, 1).Value = Right(sh2.Cells(1, F), 1)
 Else
 sh1.Cells(23, 1).End(xlDown).Offset(1).Value = sh2.Cells(1, F).Value
 End If
Next
End Sub

secondo codice
Sub posiziona3()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Scheda")
Dim sh2 As Worksheet: Set sh2 = Worksheets("Servizio")
Dim D As String
Dim F As Long
For F = 1 To 7
D = Len(sh2.Cells(1, F))
If Right(sh2.Cells(1, F), 2) = "AB" Then
 sh1.Cells(31, 2).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
 sh1.Cells(31, 2).End(xlDown).Offset(0, 1).Value = Mid(sh2.Cells(1, F), D - 1, 1)
 sh1.Cells(31, 2).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
 sh1.Cells(31, 2).End(xlDown).Offset(0, 1).Value = Right(sh2.Cells(1, F), 1)
 Else
 sh1.Cells(31, 2).End(xlDown).Offset(1).Value = sh2.Cells(1, F).Value
 End If
Next
End Sub

di patel data: 28/04/2016 12:05:14
prova con
sh1.Cells(Rows.Count, 2)..Offset(1, 0).Value = .....
di trump61 data: 28/04/2016 12:14:20
Ciao grazie per il tuo interessamento
se ho capito dovrei scrivere questo?
sh1.Cells(Rows.Count, 2).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
sh1.Cells(Rows.Count, 2).End(xlDown).Offset(1, 1).Value = Mid(sh2.Cells(1, F), D - 1, 1)
sh1.Cells(Rows.Count, 2).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
sh1.Cells(Rows.Count, 2).End(xlDown).Offset(0, 1).Value = Right(sh2.Cells(1, F), 1)
se è così mi da errore
di patel data: 28/04/2016 13:11:58
non avevo capito bene il problema, d'altra parte hai allegato un file senza dati e quindi non testabile.
Però posso dirti che le celle unite danno spesso problemi con le macro.
di trump61 data: 29/04/2016 03:48:34
Ciao, ho postato un file leggermente diverso spero si capisca meglio

di patel data: 29/04/2016 08:45:52
End(xlDown) non funziona con le celle unite perché trova celle vuote.
separa le celle della colonna B tra le righe 31 e 33, riempile con caratteri di colore bianco, modifica la macro così

Sub posiziona2()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Scheda")
Dim sh2 As Worksheet: Set sh2 = Worksheets("Servizio")
Dim D As String
Dim F As Long
For F = 1 To 7
D = Len(sh2.Cells(1, F))
If Right(sh2.Cells(1, F), 2) = "AB" Then
 sh1.Cells(31, 2).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
 sh1.Cells(31, 2).End(xlDown).Offset(0, 1).Value = Mid(sh2.Cells(1, F), D - 1, 1)
 sh1.Cells(31, 2).End(xlDown).Offset(1, 0).Value = Mid(sh2.Cells(1, F), 1, D - 2)
 sh1.Cells(31, 2).End(xlDown).Offset(0, 1).Value = Right(sh2.Cells(1, F), 1)
 Else
 sh1.Cells(31, 2).End(xlDown).Offset(1).Value = sh2.Cells(1, F).Value
 End If
Next
End Sub

di trump61 data: 29/04/2016 13:01:14
Ciao mi sono svegliato adesso perchè ho fatto il turno di notte dopo la provo.
Grazie
di trump61 data: 29/04/2016 21:35:05
Ciao grazie sembra funzionare

Vuoi Approfondire?