Bordi

Hai un problema con Excel?

Nuova discussione

Bordi
di Pich61 (utente non iscritto) data: 03/09/2014 17:32:50
Buonasera a tutti, giorni fa mi avete inviato il coice seguente e funziiona benissimo, però vorrei che nelle celle che si vanno a riempire si creasse il bordo esterno, inoltre non riesco a fare l'intestazione sulla prima riga quando lancio la macro mi pulisce tutto il foglio e va via anche l'intestazione da me creata.
Grazie
k = Range("c" & Rows.Count).End(xlUp).Row
Range("a2:c" & k & "").ClearContents
x = 2
nr = InputBox("Inserire il numero del treno:")
If nr = "" Or IsNumeric(nr) = False Then
Exit Sub
End If
Range("a2") = nr
For i = 2 To Sheets.Count
Set fin = Sheets(i).Columns(1).Find(what:=nr, lookat:=xlWhole)
If Not fin Is Nothing Then
firstAddress = fin.Address
Cells(x, 2) = Sheets(i).Name
Do
Cells(x, 3) = fin.Offset(0, 7)
x = x + 1
Set fin = Sheets(i).Columns(1).FindNext(fin)
Loop While Not fin Is Nothing And fin.Address <> firstAddress
End If
Next
di lepat (utente non iscritto) data: 03/09/2014 17:53:30
come facciamo a testare il codice senza il file ?
di Pich61 (utente non iscritto) data: 03/09/2014 21:17:58
Scusate ho allegato il file
di lepat (utente non iscritto) data: 04/09/2014 07:48:38
qualche spiegazione sull'uso ? dov'è l'intestazione che vuoi non cancellare ? vedo una pagina bianca con un pulsante, non so che numero inserire
di Pich61 (utente non iscritto) data: 04/09/2014 11:05:33
L'intestazione deve essere A1 Treno, A2 Località, A3 Binario, A4 Ora di arrivo, A5 ora di partenza, numero che puoi inserire è 2320.

di Lucas87 data: 04/09/2014 11:39:16
Ciao
1 - Range("a2:e" & k & "").ClearContents cancella i valori da A2 fino all'ultima cella occupata....sostituisci con Range("b2:e" & k & "").ClearContents
2 - Range("a2") = nr scrive in A2 il numero di treno cercato....tu lo vuoi in B1 quindi sostituisci con Range("b1") = nr
3 - Cells(x, 2) = Sheets(i).Name scrive la località sulla colonna B in verticale...tu le vuoi in orizzontale...sostituisci con Cells(2, x) = Sheets(i).Name
4 - Cells(x, 3) = fin.Offset(0, 7) stessa cosa di prima...cambia con Cells(3, x) = fin.Offset(0, 7)
5 - Per i bordi (non testato):

'da mettere prima del for
c = Range(Columns.Count & "2").End(xlToRight).Column
With Range("cells(2,2):cells(5,c)")
    .Borders(xlEdgeLeft).LineStyle = xlNone
    .Borders(xlEdgeRight).LineStyle = xlNone
    .Borders(xlEdgeTop).LineStyle = xlNone
    .Borders(xlEdgeBottom).LineStyle = xlNone
End With
'da mettere dopo il DO
With Cells(3, x)
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
End With

di Lucas87 data: 04/09/2014 12:19:44
Mi sono accorto di qualche errore

nr = InputBox("Inserire il numero del treno:")
If nr = "" Or IsNumeric(nr) = False Then
    Exit Sub
End If
x = 2
k = Cells(5, Columns.Count).End(xlToLeft).Column
If k > 1 Then
    Range(Cells(2, 2), Cells(5, k)).ClearContents
    With Range(Cells(2, 2), Cells(5, k))
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
        .Borders(xlInsideVertical).LineStyle = xlNone
        .Borders(xlInsideHorizontal).LineStyle = xlNone
    End With
End If
Range("b1") = nr
For i = 2 To Sheets.Count
    Set fin = Sheets(i).Columns(1).Find(what:=nr, lookat:=xlWhole)
    If Not fin Is Nothing Then
    firstAddress = fin.Address
    Cells(2, x) = Sheets(i).Name
    With Cells(2, x)
        .Borders(xlEdgeLeft).LineStyle = xlContinuous
        .Borders(xlEdgeRight).LineStyle = xlContinuous
        .Borders(xlEdgeTop).LineStyle = xlContinuous
        .Borders(xlEdgeBottom).LineStyle = xlContinuous
        .Borders(xlInsideVertical).LineStyle = xlContinuous
        .Borders(xlInsideHorizontal).LineStyle = xlContinuous
    End With
    Do
        Cells(3, x) = fin.Offset(0, 7)
        Cells(4, x) = fin.Offset(0, 8)
        Cells(5, x) = fin.Offset(0, 9)
        x = x + 1
        Set fin = Sheets(i).Columns(1).FindNext(fin)
    Loop While Not fin Is Nothing And fin.Address <> firstAddress
    End If
Next
k = Cells(5, Columns.Count).End(xlToLeft).Column
With Range(Cells(3, 2), Cells(5, k))
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With

di Pich61 (utente non iscritto) data: 04/09/2014 13:05:12
Tutto ok!!! Grazie

Vuoi Approfondire?