Discussione:
range in vba
(troppo vecchio per rispondere)
Marco
2006-09-16 21:36:37 UTC
Permalink
Come posso indicare dalla riga i = 2 a n = ultima riga e da colonna A a z
ultima colonna con dati in vba ?
E' un range "dinamico" dove variabili sono il numero delle righe e delle
colonne.

grazie
Norman Jones
2006-09-16 22:12:30 UTC
Permalink
Ciao Marco,

'----------------------------
Come posso indicare dalla riga i = 2 a n = ultima riga e da colonna A a z
ultima colonna con dati in vba ?
E' un range "dinamico" dove variabili sono il numero delle righe e delle
colonne.
'----------------------------

Forse il seguente codice ti aiuterà:

'================>>
Public Sub Demo()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng1 As Range
Dim Rng2 As Range
Dim rCell As Range
Dim aCell As Range
Dim iLastRow As Long
Dim iLastCol As Long
Const myCol As String = "A" '<<===== da CAMBIARE
Const myRow As Long = 1 '<<==== da CAMBIARE

Set WB = Workbooks("Pippo.xls") '<<==== da CAMBIARE
Set SH = WB.Sheets("Foglio1") '<<==== da CAMBIARE

iLastRow = SH.Cells(Rows.Count, myCol).End(xlUp).Row
iLastCol = SH.Cells(myRow, Columns.Count).End(xlToLeft).Column

Set Rng1 = SH.Range(myCol & 2 & ":" & myCol & iLastRow)
Set Rng2 = SH.Range("A1").Resize(1, iLastCol)

For Each rCell In Rng1.Cells
'Fai qualcosa, e.g.:
With rCell
MsgBox .Address
.Interior.ColorIndex = 6
End With
Next rCell

For Each aCell In Rng2.Cells
'Fai qualcosa, e.g.:
With aCell
MsgBox .Address
.Interior.ColorIndex = 5
End With
Next aCell
End Sub
'<<================



---
Regards,
Norman
eliano
2006-09-17 00:44:01 UTC
Permalink
Post by Marco
Come posso indicare dalla riga i = 2 a n = ultima riga e da colonna A a z
ultima colonna con dati in vba ?
E' un range "dinamico" dove variabili sono il numero delle righe e delle
colonne.
grazie
Ciao Marco.
Rispondere qualcosa dopo la risposta esaustiva di Norman o è presunzione o è
pura follia.:-))
Forse ha ragione giovanna: devo esere un po' pazzo, per cui prova:

Sub ultima_riga_colonna()
Dim R As Double
Dim C As Double
R = ActiveSheet.UsedRange.Rows.Count 'ultima riga
C = ActiveSheet.UsedRange.Columns.Count 'ultima colonna
MsgBox "Ultima colonna = " & Columns(C).Address & " Ultima riga = " & R
End Sub

Eliano
cucchiaino
2006-09-17 04:18:59 UTC
Permalink
eliano wrote:

ciao eliano.
Post by eliano
Post by Marco
Come posso indicare dalla riga i = 2 a n = ultima riga e da colonna A a z
ultima colonna con dati in vba ?
E' un range "dinamico" dove variabili sono il numero delle righe e delle
colonne.
Ciao Marco.
Rispondere qualcosa dopo la risposta esaustiva di Norman o è presunzione o è
pura follia.:-))
La seconda che hai detto! :-)
Post by eliano
Sub ultima_riga_colonna()
Dim R As Double
Dim C As Double
R = ActiveSheet.UsedRange.Rows.Count 'ultima riga
C = ActiveSheet.UsedRange.Columns.Count 'ultima colonna
MsgBox "Ultima colonna = " & Columns(C).Address & " Ultima riga = " & R
End Sub
I conteggi sulla zona UsedRange possono riservare
sorprese sgradite:

- posizionati su un foglio nuovo
- inserisci in D10 una stringa qualunque
- avvia la tua macro
- sopresa!


()---cucchiaino
eliano
2006-09-17 21:28:02 UTC
Permalink
Post by cucchiaino
ciao eliano.
Post by eliano
Post by Marco
Come posso indicare dalla riga i = 2 a n = ultima riga e da colonna A a z
ultima colonna con dati in vba ?
E' un range "dinamico" dove variabili sono il numero delle righe e delle
colonne.
Ciao Marco.
Rispondere qualcosa dopo la risposta esaustiva di Norman o è presunzione o è
pura follia.:-))
La seconda che hai detto! :-)
Post by eliano
Sub ultima_riga_colonna()
Dim R As Double
Dim C As Double
R = ActiveSheet.UsedRange.Rows.Count 'ultima riga
C = ActiveSheet.UsedRange.Columns.Count 'ultima colonna
MsgBox "Ultima colonna = " & Columns(C).Address & " Ultima riga = " & R
End Sub
I conteggi sulla zona UsedRange possono riservare
- posizionati su un foglio nuovo
- inserisci in D10 una stringa qualunque
- avvia la tua macro
- sopresa!
Ciao cucchiaino.
Nessuna sorpresa, avevo già verificato in altre occasioni la situazione da
te esposta, oltrre ad altre quisquilie et pinzellacchere legate
all'UsedRange, indirizzandomi verso altre soluzioni.
Per quanto riguarda il problema giustamente da te posto, mi semvra di
ricordare di averlo risolto in questa maniera:

Sub ultima_riga_colonna()
Dim R As Double
Dim C As Double
Dim X As String
x = Range("A1").Value
If Range("A1").Value = "" Then Range("A1").Value = "x"
R = ActiveSheet.UsedRange.Rows.Count 'ultima riga
C = ActiveSheet.UsedRange.Columns.Count 'ultima colonna
Range("A1").value = x
MsgBox "Ultima colonna = " & Columns(C).Address & " Ultima riga = " & R
End Sub

Scuse anticipate: l'ho scritta a memoria e non l'ho provata, e siccome vengo
da un post sull'Alzheimer.....:-)).
Per quanto riguarda il thread devo ancora leggerlo tutto, ma ho
l'impressione che abbia un po' debordato rispetto al post iniziale; appena
posso lo leggo.
Eliano
Norman Jones
2006-09-17 06:36:43 UTC
Permalink
Ciao Eliano,

Cucchiaino (ciao) ha spiegato che l'uso della zona UsedRange possa
essere problematico. Per quanto riguarda il problema specifico indicato
da Cucchiaino, e' necessario sempre ricordarsi che la prima cella
dell'UsedRange possa non essere la prima cella del foglio, i.e. A1.
Pertanto si avrebbe potuto scrivere la tua macro in modo di superare il
problema di Cucchiaino:

'=============>>
Sub Ultima_Riga_Colonna2()
Dim R As Double
Dim C As Double

With ActiveSheet.UsedRange
R = .Row + .Rows.Count - 1 'ultima riga
C = .Column + .Columns.Count - 1 ' ultima colonna
End With

MsgBox "Ultima colonna = " _
& Columns(C).Address _
& " Ultima riga = " & R
End Sub
'<<=============
Post by cucchiaino
I conteggi sulla zona UsedRange possono riservare
Come esempio, prova la seguente versione della macro:

'=============>>
Sub Ultima_Riga_Colonna3()
Dim R As Double
Dim C As Double

With Cells(Rows.Count, Columns.Count)
.Interior.ColorIndex = 3
.ClearContents
End With

With ActiveSheet.UsedRange
R = .Row + .Rows.Count - 1 'ultima riga
C = .Column + .Columns.Count - 1 ' ultima colonna
End With

MsgBox "Ultima colonna = " _
& Columns(C).Address _
& " Ultima riga = " & R
End Sub
'<<=============

In generale, la mia macro restituirebbe l'ultima cella popolata nella
colonna di interesse e l'ultima cella popolata nella riga stipulata; l'uso
della zona UsedRange potrebbe restituire l'ultima cella che sia stata
modificata - anche se la cella non è popolata ed anche se il contenuto
(o il formato) della cella fosse cancellato successivamente.

Detto questo, si dovrebbe notare che si possa aver dei problemi anche
con la mia macro: prova ad esempio:

'=============>>
Public Sub Tester()
Dim SH As Worksheet
Dim rng As Range
Dim iLastRow As Long
Dim iLastCol As Long

Set SH = ActiveSheet

With SH
.Cells.Clear
.Range("A1:K1000").Value = "Pippo"

.Columns("B:K").Hidden = True
.Rows("2:1000").Hidden = True

iLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
iLastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With

MsgBox "L'ultima riga = " & iLastRow _
& vbNewLine _
& "L'ultima colonna = " & iLastCol
End Sub
'<<=============

Pertanto, se c'è la possibilità di dubbio, preferisco usare le seguenti
due funzioni:

'=============>>
Function LastRow(SH As Worksheet)
On Error Resume Next
LastRow = SH.Cells.Find(What:="*", _
After:=SH.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

'--------------->

Function LastCol(SH As Worksheet)
On Error Resume Next
LastCol = SH.Cells.Find(What:="*", _
After:=SH.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'<<=============


---
Regards,
Norman
Norman Jones
2006-09-17 07:02:12 UTC
Permalink
Ciao Eliano,
Post by eliano
Dim R As Double
Dim C As Double
avrebbero potuto essere:

Dim R As Long
Dim C As Long

- A meno che non aspetti una versione futura di Excel con più di
2147483647 colonne e più di 2147483647 righe!


---
Regards,
Norman
eliano
2006-09-18 01:18:02 UTC
Permalink
Post by Norman Jones
Ciao Eliano,
Post by eliano
Dim R As Double
Dim C As Double
Dim R As Long
Dim C As Long
- A meno che non aspetti una versione futura di Excel con più di
2147483647 colonne e più di 2147483647 righe!
LOL
Melius abundare quam deficere!
No, eh Norman? :-8)
'Nottee
Eliano
Norman Jones
2006-09-18 06:09:45 UTC
Permalink
Ciao Eliano,
Post by eliano
Melius abundare quam deficere!
No, eh Norman? :-8)
Certo!

Aliena vitia in oculis habemus, a tergo nostra sunt!


---
Regards,
Norman
eliano
2006-09-18 13:47:27 UTC
Permalink
Post by Norman Jones
Ciao Eliano,
Post by eliano
Melius abundare quam deficere!
No, eh Norman? :-8)
Certo!
Aliena vitia in oculis habemus, a tergo nostra sunt!
Ciao Norman.
Quindi procediamo pure, ratti (cioè veloci), rapidi (idem), ma accorti
(cioè con attenzione), perchè se quelli ci stanno a tergo, non si sa
mai.:-8)
Eliano
Marco
2006-09-17 07:42:38 UTC
Permalink
ciao
Norman Jones
Post by Norman Jones
Ciao Eliano,
Cucchiaino (ciao) Pertanto, se c'è la possibilità di dubbio, preferisco
usare le seguenti
'=============>>
Function LastRow(SH As Worksheet)
On Error Resume Next
LastRow = SH.Cells.Find(What:="*", _
After:=SH.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'--------------->
Function LastCol(SH As Worksheet)
On Error Resume Next
LastCol = SH.Cells.Find(What:="*", _
After:=SH.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'<<=============
Pensavo fosse per me più semplice.
Come posso integrare le due funzioni per un range con righe alterne (ops, mi
ero dimenticato ) e colonne seguenti .
Es il range che vorrei poter modificare

range B2:K186
da modificare
B2:K2, B4:K4, B6:K6...
Range("B2:K2,B4:K4,B6:K6.....").Interior.ColorIndex = 15
Post by Norman Jones
---
Regards,
Norman
saluti
cucchiaino
2006-09-17 08:47:36 UTC
Permalink
Post by Marco
Es il range che vorrei poter modificare
range B2:K186
da modificare
B2:K2, B4:K4, B6:K6...
Range("B2:K2,B4:K4,B6:K6.....").Interior.ColorIndex = 15
Se vuoi colorare solo le celle piene:

Sub coloratesivedonomeglio()
Dim c As Range

Set c = Worksheets("Foglio1") _
.Range("B:K") _
.SpecialCells(xlCellTypeConstants)

c.Interior.ColorIndex = 15

End Sub


()---cucchiaino
Marco
2006-09-17 09:29:31 UTC
Permalink
Post by cucchiaino
Sub coloratesivedonomeglio()
Dim c As Range
Set c = Worksheets("Foglio1") _
.Range("B:K") _
.SpecialCells(xlCellTypeConstants)
c.Interior.ColorIndex = 15
End Sub
Sarebbe limitativo nel foglio e nel range.
Questo le colora tutte le celle del range , non i modo alternato e in più
sul mio foglio succede uno dei casi sopra ovvero non colora la colonna H.
Post by cucchiaino
()---cucchiaino
ciao
Norman Jones
2006-09-17 09:03:19 UTC
Permalink
Ciao Marco,

'---------------------
Pensavo fosse per me più semplice.
Come posso integrare le due funzioni per un range con righe alterne (ops,
mi
ero dimenticato ) e colonne seguenti .
Es il range che vorrei poter modificare

range B2:K186
da modificare
B2:K2, B4:K4, B6:K6...
Range("B2:K2,B4:K4,B6:K6.....").Interior.ColorIndex = 15

'---------------------

Prova:
'================>>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long

Set WB = Workbooks("Pippo.xls") '<<===== da CAMBIARE
Set SH = WB.Sheets("Foglio1") '<<===== da CAMBIARE

iLastRow = LastRow(SH.Columns("B:K"))

Set Rng = SH.Range("B2:K" & iLastRow)

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'--------------->

Function LastRow(Optional Rng As Range) As Long

If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<================


---
Regards,
Norman
Marco
2006-09-17 09:41:47 UTC
Permalink
Ciao Norman Jones
Post by Norman Jones
'================>>
Public Sub Tester()
Dim WB As Workbook
Dim SH As Worksheet
Dim Rng As Range
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
Set WB = Workbooks("Pippo.xls") '<<===== da CAMBIARE
Set SH = WB.Sheets("Foglio1") '<<===== da CAMBIARE
Sarebbe limitativo nel file e foglio, ma forse basta scrivere

Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
Post by Norman Jones
iLastRow = LastRow(SH.Columns("B:K"))
Set Rng = SH.Range("B2:K" & iLastRow)
Anche qui pone un limite nel range stabilito a priori, ovvero se io
desiderassi modificare es da E6:J non sarebbe possibile.
Non so se si può tradurre in vba
tutto ciò che contiene qualcosa CONTIGUO (per colonna) a destra della cella
attiva e tutto ciò che contiene qualcosa ALTERNATO (per riga) in basso della
cella attiva
Post by Norman Jones
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'--------------->
Function LastRow(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<================
---
Regards,
Norman
saluti
Norman Jones
2006-09-17 10:13:46 UTC
Permalink
Ciao Marco,
Post by Marco
Post by Norman Jones
Set WB = Workbooks("Pippo.xls") '<<===== da CAMBIARE
Set SH = WB.Sheets("Foglio1") '<<===== da CAMBIARE
Sarebbe limitativo nel file e foglio, ma forse basta scrivere
Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
Certo. Infatti potresti semplicemente utlizzarre la sola riga:

Set SH = WB.ActiveSheet

Tuttavia, la mia versione è molto più flessibile: la brevità non è sempre
una virtù!
Post by Marco
Post by Norman Jones
iLastRow = LastRow(SH.Columns("B:K"))
Set Rng = SH.Range("B2:K" & iLastRow)
Anche qui pone un limite nel range stabilito a priori, ovvero se io
desiderassi modificare es da E6:J non sarebbe possibile.
??? Perche' no?
Post by Marco
Non so se si può tradurre in vba
tutto ciò che contiene qualcosa CONTIGUO (per colonna) a destra della
cella attiva e tutto ciò che contiene qualcosa ALTERNATO (per riga) in
basso della cella attiva
Tutto e' possibile, ma io non riesco a capire le tue esigenze.


---
Regards,
Norman
Marco
2006-09-17 11:49:04 UTC
Permalink
ciao Norman
Post by Norman Jones
Post by Marco
Post by Norman Jones
iLastRow = LastRow(SH.Columns("B:K"))
Set Rng = SH.Range("B2:K" & iLastRow)
Anche qui pone un limite nel range stabilito a priori, ovvero se io
desiderassi modificare es da E6:J non sarebbe possibile.
??? Perche' no?
Colorerebbe anche le "colonne" B,C,D, K con o senza dati, al di fuori del
nuovo range.

In sostanza la macro la userei in vari fogli (Set SH = WB.ActiveSheet e qui
va bene) che hanno vari range.
O scrivo 5 macro con i vari range o si trova il modo di avere un range
"dinamico" come paventato nel primo post per usare un'unica macro; da una
cella attiva nel foglio tutto ciò che stà a destra e in basso rappresenta il
range sempre con il distinguo di a destra contiguo e in basso alternato.
Post by Norman Jones
Post by Marco
Non so se si può tradurre in vba
tutto ciò che contiene qualcosa CONTIGUO (per colonna) a destra della
cella attiva e tutto ciò che contiene qualcosa ALTERNATO (per riga) in
basso della cella attiva
Tutto e' possibile, ma io non riesco a capire le tue esigenze.
---
Regards,
Norman
saluti
Norman Jones
2006-09-17 12:41:41 UTC
Permalink
Ciao Marco,
Post by Marco
In sostanza la macro la userei in vari fogli (Set SH = WB.ActiveSheet e
qui va bene) che hanno vari range.
O scrivo 5 macro con i vari range o si trova il modo di avere un range
"dinamico" come paventato nel primo post per usare un'unica macro; da una
cella attiva nel foglio tutto ciò che stà a destra e in basso rappresenta
il range sempre con il distinguo di a destra contiguo e in basso
alternato.
Prova:
'================>>
Public Sub Tester3()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long

With ActiveCell
iCol = .End(xlToRight).Column
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, iCol - .Column + 1)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub

'----------------->

Function LastRow(Optional Rng As Range) As Long

If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<================



---
Regards,
Norman
Marco
2006-09-17 14:01:32 UTC
Permalink
Ciao Norman Jones
Post by Norman Jones
'================>>
Public Sub Tester3()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
With ActiveCell
iCol = .End(xlToRight).Column
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, iCol - .Column + 1)
End With
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'----------------->
Function LastRow(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<================
Funziona si e no, ovvero per i test che ho fatto fà il riempimento in tutte
le celle alternate delle colonne a destra se la prima cella o cella attiva è
nella colonna B o seguenti, mentre si mi posiziono in una cella della
colonna A fà il riempimento solo di tre colonne.
es A20 riempimento A20: C2750 del foglio mentre il range è A20:H2750
Post by Norman Jones
---
Regards,
Norman
saluti
Norman Jones
2006-09-17 14:32:39 UTC
Permalink
Ciao Marco,
Post by Marco
Funziona si e no, ovvero per i test che ho fatto fà il riempimento in
tutte le celle alternate delle colonne a destra se la prima cella o cella
attiva è nella colonna B o seguenti, mentre si mi posiziono in una cella
della colonna A fà il riempimento solo di tre colonne.
es A20 riempimento A20: C2750 del foglio mentre il range è A20:H2750
Nel contesto del thead, capisco quasi nulla!

Forse sarebbe meglio se mi mandassi il foglio problematico, mostrando
l'intervallo da essere evidenziata:

***@NOSPAMbtconnectDOTcom

(Cancella "NOSPAM" e sostituisci "DOT" con un punto)


---
Regards,
Norman
Norman Jones
2006-09-18 06:43:48 UTC
Permalink
Ciao Marco,
Post by Norman Jones
Forse sarebbe meglio se mi mandassi il foglio problematico, mostrando
Ho ricevuto il tuo file.

Mi sembra che il codice funziona tranne si il punto di partenza sia nella
prima colonna; questo e' dovuto al fatto che la colonna B e' vuota.

Per evitare questo problema, prova la seguente versione del codice:
'=============>>
Public Sub Tester3()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long

With ActiveCell
If .Column = 1 Then
iCol = .Offset(0, 2).End(xlToRight).Column
Else
iCol = .End(xlToRight).Column
End If
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub

'--------------------->

Function LastRow(Optional Rng As Range) As Long

If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<=============

Ti ho mandato il file aggiornato.


---
Regards,
Norman
Marco
2006-09-18 13:12:53 UTC
Permalink
Ciao Norman,
Post by Norman Jones
'=============>>
Public Sub Tester3()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
With ActiveCell
If .Column = 1 Then
iCol = .Offset(0, 2).End(xlToRight).Column
Else
iCol = .End(xlToRight).Column
End If
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1)
End With
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'--------------------->
Function LastRow(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<=============
C'è poco da provare funziona perfettamente.
Le colonne vuote non sono una consuetudine, ma il test è stato fatto su file
che contempla più variabili ed in modo più estensivo.

grazie
Post by Norman Jones
---
Regards,
Norman
saluti
Marco
2006-09-21 08:43:49 UTC
Permalink
Post by Norman Jones
Mi sembra che il codice funziona tranne si il punto di partenza sia nella
prima colonna; questo e' dovuto al fatto che la colonna B e' vuota.
'=============>>
Public Sub Tester3()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
With ActiveCell
If .Column = 1 Then
iCol = .Offset(0, 2).End(xlToRight).Column
Else
iCol = .End(xlToRight).Column
End If
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1)
End With
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'--------------------->
Function LastRow(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<=============
Volendo apporre altre modifiche al foglio (in tutta l'area anche il
contenuto sopra la selezione), ovvero mettere i bordi alle celle e la prima
riga in grassetto, sfondo blu, font bianco, come cambierebbe il codice?
Post by Norman Jones
Regards,
Norman
Grazie
Saluti
Norman Jones
2006-09-21 08:58:56 UTC
Permalink
Ciao Marco,

'------------------------
Volendo apporre altre modifiche al foglio (in tutta l'area anche il
contenuto sopra la selezione), ovvero mettere i bordi alle celle e la prima
riga in grassetto, sfondo blu, font bianco, come cambierebbe il codice?

'------------------------

Potresti mandarmi un file d'esmpio?

Posterò il codice in una risposta nel NG.


---
Regards,
Norman
Norman Jones
2006-09-21 11:00:07 UTC
Permalink
Ciao Marco,
Post by Norman Jones
'------------------------
Volendo apporre altre modifiche al foglio (in tutta l'area anche il
contenuto sopra la selezione), ovvero mettere i bordi alle celle e la prima
riga in grassetto, sfondo blu, font bianco, come cambierebbe il codice?
'------------------------
Potresti mandarmi un file d'esmpio?
Posterò il codice in una risposta nel NG.
Ho ricevuto il tuo file d'esempio.

Prova la seguente codice:

'=============>>
Public Sub Tester4()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
Dim Rng2 As Range

With ActiveCell
If .Column = 1 Then
iCol = .Offset(0, 2).End(xlToRight).Column
Else
iCol = .End(xlToRight).Column
End If
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i

Set Rng2 = Range("A1", Rng)

With Rng2
With .Rows(1)
.Interior.ColorIndex = 25
.Font.ColorIndex = 2
.Font.Bold = True
End With
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

ActiveWindow.DisplayGridlines = False
XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub

'--------------------->

Function LastRow(Optional Rng As Range) As Long

If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<=============


---
Regards,
Norman
Marco
2006-09-21 12:27:53 UTC
Permalink
Post by Norman Jones
'=============>>
Public Sub Tester4()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
Dim Rng2 As Range
With ActiveCell
If .Column = 1 Then
iCol = .Offset(0, 2).End(xlToRight).Column
Else
iCol = .End(xlToRight).Column
End If
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1)
Giusto per chiarimento: se mi posiziono in una cella della colonna vuota le
due righe sopra danno errore.
Se le colonne vuote nel foglio sono due consecutive e mi posiziono nella
precedente, il codice si blocca (colorazione) nella collonna successiva alle
vuote.
Se le colonne vuote nel foglio sono due non consecutive, il codice si
blocca (colorazione) nella colonna precedente alla seconda vuota.
Se la colonna vuota non è in seconda posizione (B) ma in altra colonna del
foglio, il codice si blocca (colorazione) nella collonna precedente alla
vuota.
In entrambi gli ultimi tre casi non trova l'ultima colonna-cella del foglio.
?
Post by Norman Jones
End With
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i
Set Rng2 = Range("A1", Rng)
With Rng2
With .Rows(1)
.Interior.ColorIndex = 25
.Font.ColorIndex = 2
.Font.Bold = True
End With
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
ActiveWindow.DisplayGridlines = False
Fa un cosa in più dell'esempio, ed è più elegante.
Post by Norman Jones
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'--------------------->
Function LastRow(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<=============
---
Regards,
Norman
grazie saluti
Norman Jones
2006-09-21 12:55:17 UTC
Permalink
Ciao Marco,
Post by Marco
Giusto per chiarimento: se mi posiziono in una cella della colonna vuota
le due righe sopra danno errore.
Se le colonne vuote nel foglio sono due consecutive e mi posiziono nella
precedente, il codice si blocca (colorazione) nella collonna successiva
alle vuote.
Se le colonne vuote nel foglio sono due non consecutive, il codice si
blocca (colorazione) nella colonna precedente alla seconda vuota.
Se la colonna vuota non è in seconda posizione (B) ma in altra colonna del
foglio, il codice si blocca (colorazione) nella collonna precedente alla
vuota.
In entrambi gli ultimi tre casi non trova l'ultima colonna-cella del foglio.
?
Potresti incorporare il seguente codice:
'=============>>
Public Sub Tester002()
If Application.CountA(ActiveCell.EntireColumn) = 0 Then
MsgBox Prompt:="Questa procedura non puo' essere " _
& "eseguita da una colonna vuota. " _
& vbNewLine & " Seleziona una altra" _
& " colonna e riprova!", _
Buttons:=vbCritical, _
Title:="Errore"
Exit Sub
End If
End Sub
'<<=============


---
Regards,
Norman
Marco
2006-09-21 13:12:40 UTC
Permalink
Ciao Norman Jones,
Post by Norman Jones
'=============>>
Public Sub Tester002()
If Application.CountA(ActiveCell.EntireColumn) = 0 Then
MsgBox Prompt:="Questa procedura non puo' essere " _
& "eseguita da una colonna vuota. " _
& vbNewLine & " Seleziona una altra" _
& " colonna e riprova!", _
Buttons:=vbCritical, _
Title:="Errore"
Exit Sub
End If
End Sub
'<<=============
Io l'ho messa all'inizio del codice e funziona ma quando clicco su ok
compare l'errore nel codice:
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1).

Come potrei evitare il blocco?
Post by Norman Jones
---
Regards,
Norman
Grazie saluti
Norman Jones
2006-09-21 13:22:48 UTC
Permalink
Ciao Marco,
Post by Marco
Io l'ho messa all'inizio del codice e funziona ma quando clicco su ok
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1).
Non capisco in quanto, se la colonna fosse vuota, si uscirebbe dalla
Post by Marco
Post by Norman Jones
Exit Sub
Forse, mandarmi il file problematico e indicare la cella da selezionare.

Non sono sicuro che potro' rispondere immediatamente, potrebbe essere anche
stasera.


---
Regards,
Norman
Norman Jones
2006-09-21 19:52:54 UTC
Permalink
Ciao Marco,

Ho recevuto il tuo file.

Io avevo suggerito il codice:
'=============>>
Public Sub Tester002()
If Application.CountA(ActiveCell.EntireColumn) = 0 Then
MsgBox Prompt:="Questa procedura non puo' essere " _
& "eseguita da una colonna vuota. " _
& vbNewLine & " Seleziona una altra" _
& " colonna e riprova!", _
Buttons:=vbCritical, _
Title:="Errore"
Exit Sub
End If
End Sub
'<<=============

Incorporando questo codice nella procedura principale, hai cancellato la
riga:

Exit Sub

Utilizzando questa riga, non incontro il tuo errore:
'=============>>
Public Sub Tester4()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
Dim Rng2 As Range

With ActiveCell

If Application.CountA(ActiveCell.EntireColumn) = 0 Then
MsgBox Prompt:="Questa procedura non puo' essere " _
& "eseguita da una colonna vuota. " _
& vbNewLine & " Seleziona una altra" _
& " colonna e riprova!", _
Buttons:=vbCritical, _
Title:="Errore"
Exit Sub '<<=== Avevi cancellato quest riga!!
End If

If .Column = 1 Then
iCol = .Offset(0, 2).End(xlToRight).Column
Else
iCol = .End(xlToRight).Column
End If
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1)
End With

On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With

For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i

Set Rng2 = Range("A1", Rng)

With Rng2
With .Rows(1)
.Interior.ColorIndex = 25
.Font.ColorIndex = 2
.Font.Bold = True
End With
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

ActiveWindow.DisplayGridlines = False

XIT:
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With

End Sub

'--------------------->

Function LastRow(Optional Rng As Range) As Long

If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<=============

Ti ho mandato un file aggiornato.


---
Regards,
Norman
Marco
2006-09-22 07:08:46 UTC
Permalink
Post by Norman Jones
'=============>>
Public Sub Tester002()
If Application.CountA(ActiveCell.EntireColumn) = 0 Then
MsgBox Prompt:="Questa procedura non puo' essere " _
& "eseguita da una colonna vuota. " _
& vbNewLine & " Seleziona una altra" _
& " colonna e riprova!", _
Buttons:=vbCritical, _
Title:="Errore"
Exit Sub
End If
End Sub
'<<=============
Incorporando questo codice nella procedura principale, hai cancellato la
Exit Sub
Hai perfettamente ragione!; strano di solito Ctrl-C Ctrl-V mi riesce facile.
;-)
Post by Norman Jones
'=============>>
Public Sub Tester4()
Dim Rng As Range
Dim RngA As Range
Dim iCol As Long
Dim iLastRow As Long
Dim i As Long
Dim CalcMode As Long
Dim Rng2 As Range
With ActiveCell
If Application.CountA(ActiveCell.EntireColumn) = 0 Then
MsgBox Prompt:="Questa procedura non puo' essere " _
& "eseguita da una colonna vuota. " _
& vbNewLine & " Seleziona una altra" _
& " colonna e riprova!", _
Buttons:=vbCritical, _
Title:="Errore"
Exit Sub '<<=== Avevi cancellato quest riga!!
End If
If .Column = 1 Then
iCol = .Offset(0, 2).End(xlToRight).Column
Else
iCol = .End(xlToRight).Column
End If
Set RngA = .Resize(Rows.Count - .Row + 1)
iLastRow = LastRow(RngA)
Set Rng = .Resize(iLastRow - .Row + 1, _
iCol - .Column + 1)
End With
On Error GoTo XIT
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i
Set Rng2 = Range("A1", Rng)
With Rng2
With .Rows(1)
.Interior.ColorIndex = 25
.Font.ColorIndex = 2
.Font.Bold = True
End With
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With
ActiveWindow.DisplayGridlines = False
With Application
.Calculation = CalcMode
.ScreenUpdating = True
End With
End Sub
'--------------------->
Function LastRow(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<=============
Comunque la nuova procedura risolve in parte il problema delle colonne
vuote. Per eseguire il codice e apporre la colorazione al foglio non basta
spostarsi di cella-colonna, ma bisogna prima eliminare la colonna vuota.

Forse il limite è impostato qui: ?
Post by Norman Jones
iCol = .Offset(0, 2).End(xlToRight).Column
---
Regards,
Norman
grazie
saluti
Norman Jones
2006-09-22 11:13:38 UTC
Permalink
Ciao Marco,
Post by Marco
Comunque la nuova procedura risolve in parte il problema delle colonne
vuote. Per eseguire il codice e apporre la colorazione al foglio non basta
spostarsi di cella-colonna, ma bisogna prima eliminare la colonna vuota.
Forse il limite è impostato qui: ?
Post by Norman Jones
iCol = .Offset(0, 2).End(xlToRight).Column
Nel caso che la cella attiva fosse in una colonna vuota si potrebbe:

(a) Appore la colorazione dalla colonna attiva (e vuota) sino alla prossima
colonna popolata

(b) Appore la colorazione dalla colonna attiva (e vuota) sino all'ultima
colonna popolata e contugua con la prossima colonna popolata

(c) Aporre la colorazione dalla prossima colonna popolata sino all'ultima
contigua colonna popolata, saltando la colonna(e) vuota(e).

Oltre a queste possibilità, si potrebbe eliminare le colonne vuote. Posso
adattare il codice per effettuare ognuno di questi metodi, ma devo capire le
tue intenzioni.


---
Regards,
Norman
Marco
2006-09-22 12:47:22 UTC
Permalink
Post by Norman Jones
Ciao Marco,
Ciao
Post by Norman Jones
(a) Appore la colorazione dalla colonna attiva (e vuota) sino alla prossima
colonna popolata
(b) Appore la colorazione dalla colonna attiva (e vuota) sino all'ultima
colonna popolata e contugua con la prossima colonna popolata
(c) Aporre la colorazione dalla prossima colonna popolata sino all'ultima
contigua colonna popolata, saltando la colonna(e) vuota(e).
Oltre a queste possibilità, si potrebbe eliminare le colonne vuote. Posso
adattare il codice per effettuare ognuno di questi metodi, ma devo capire
le tue intenzioni.
Ora mi metti in confusione.
Per me la colorazione delle celle per riga alternate (grigio) andrebbe dalla
cella-colonna attiva a destra e in basso fino all'ultima riga dell' ultima
colonna con dati nel foglio, mentre i bordi (nero)e la formattazione prima
riga (blu, bianco) andrebbe da A1 al punto a destra in basso di prima.(
nell' Esempio2 foglio1il massimo range è A1:H179)
Se le colonne vuote fossero alterne ai dati il range sarebbe A1:L179 ultima
colonna popolata L.
Le colonne vuote contigue al massimo sono due.
Il codice attuale al MASSIMO colora le celle del range con una SOLA colonna
vuota o due se sono contigue, mentre non appone la colorazione alle celle
della seconda colonna vuota e seguenti.
Non vorrei disturbarti oltre con qualcosa che magari non si può fare.
Quindi in sostanza il range totale va da A1 e temina nell'ultima colonna
popolata e al suo interno si avranno una o più colonne vuote con al massimo
due contigue, il range righe va dalla cella attiva all'ultima colonna
popolata, ultima riga.
Spero di essermi spiegato. ?
Post by Norman Jones
---
Regards,
Norman
Grazie saluti

Ps Forse più rapido è eliminare le colonne vuote, al limite si possono
ricreare con già la colorazione.
Norman Jones
2006-09-22 14:04:18 UTC
Permalink
Ciao Marco,
Post by Marco
Ora mi metti in confusione
Credo che io pensassi di un modello troppo complesso!

Comuque, prova:

'=============>>
Public Sub Tester5()
Dim Rng As Range
Dim iCol As Long
Dim iRow As Long
Dim i As Long
Dim CalcMode As Long

With ActiveCell
iCol = LastCol(.Parent.UsedRange)
iRow = LastRow(.Parent.UsedRange)

Set Rng = Range(ActiveCell, Cells(iRow, iCol))
End With

On Error GoTo XIT
Application.ScreenUpdating = True
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i

XIT:
Application.ScreenUpdating = True
End Sub

'--------------------->

Function LastRow(Optional Rng As Range) As Long

If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If

On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

'--------------------->

Function LastCol(Optional Rng As Range) As Long

If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If

On Error Resume Next
LastCol = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'<<=============


---
Regards,
Norman
Marco
2006-09-22 14:30:50 UTC
Permalink
Post by Norman Jones
Ciao Marco,
ciao
Post by Norman Jones
Post by Marco
Ora mi metti in confusione
Credo che io pensassi di un modello troppo complesso!
Chi è bravo supera sempre gli ostacoli. ;-)
Post by Norman Jones
'=============>>
Public Sub Tester5()
Dim Rng As Range
Dim iCol As Long
Dim iRow As Long
Dim i As Long
Dim CalcMode As Long
Dim Rng2 As Range '<<=== è meglio fare tutto in una volta a questo punto
Post by Norman Jones
With ActiveCell
iCol = LastCol(.Parent.UsedRange)
iRow = LastRow(.Parent.UsedRange)
Set Rng = Range(ActiveCell, Cells(iRow, iCol))
End With
Set Rng2 = Range("A1", Rng) '<<=== speriamo bene, non desidero rovinare
nulla

With Rng2
With .Rows(1)
.Interior.ColorIndex = 25
.Font.ColorIndex = 2
.Font.Bold = True
End With
With .Borders
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

ActiveWindow.DisplayGridlines = False
Post by Norman Jones
On Error GoTo XIT
Application.ScreenUpdating = True
For i = 1 To Rng.Rows.Count Step 2
Rng.Rows(i).Interior.ColorIndex = 15
Next i
Application.ScreenUpdating = True
End Sub
'--------------------->
Function LastRow(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'--------------------->
Function LastCol(Optional Rng As Range) As Long
If Rng Is Nothing Then
Set Rng = ActiveSheet.UsedRange
End If
On Error Resume Next
LastCol = Rng.Find(What:="*", _
After:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
'<<=============
---
Regards,
Norman
grazie
saluti
Norman Jones
2006-09-22 15:15:07 UTC
Permalink
Ciao Marco,
Post by Marco
Dim Rng2 As Range '<<=== è meglio fare tutto in una volta a questo punto
Per quanto riguarda i bordi, ti avevo gia' suggerito il codice - in questo
momento volevo superare i problemi degl;ultimi post. Se il nuovo codice
risolva questi problemi, hai ragione di incorporare il codice per i bordi e
le intestazione.


---
Regards,
Norman

Loading...