range in vba
Marco
ultima colonna con dati in vba ?
E' un range "dinamico" dove variabili sono il numero delle righe e delle
colonne.
grazie
Norman Jones
'----------------------------
'----------------------------
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
"Marco" ha scritto:
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
ciao eliano.
> "Marco" ha scritto:
> > 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! :-)
>
> 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
Norman Jones
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
'<<=============
Tuttavia, concordo pienamente con Cucchiano:
> I conteggi sulla zona UsedRange possono riservare
> sorprese sgradite:
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
Avrei voluto anche dire che le dichiarazioni:
> 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
Marco
ciao
Norman Jones
> Ciao Eliano,
>
> Cucchiaino (ciao) Pertanto, se c'è la possibilità di dubbio, preferisco
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
>
>
> ---
> Regards,
> Norman
>
saluti
cucchiaino
> 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
Norman Jones
'---------------------
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
cucchiaino wrote
> 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
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.
>
>
> ()---cucchiaino
ciao
Marco
Ciao Norman Jones
> 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
Sarebbe limitativo nel file e foglio, ma forse basta scrivere
Set WB = ActiveWorkbook
Set SH = WB.ActiveSheet
>
> 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
saluti
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ù!
>> 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?
> 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
ciao Norman
>>> 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.
>
>> 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
> 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
'----------------->
Marco
Ciao Norman Jones
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
>
>
>
> ---
> Regards,
> Norman
saluti
Norman Jones
> 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:
norman_jones@NOSPAMbtconnectDOTcom
(Cancella "NOSPAM" e sostituisci "DOT" con un punto)
---
Regards,
Norman
eliano
"cucchiaino" ha scritto:
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
eliano
"Norman Jones" ha scritto:
LOL
Melius abundare quam deficere!
No, eh Norman? :-8)
'Nottee
Eliano
Norman Jones
> Melius abundare quam deficere!
> No, eh Norman? :-8)
Certo!
Aliena vitia in oculis habemus, a tergo nostra sunt!
---
Regards,
Norman
Norman Jones
> Forse sarebbe meglio se mi mandassi il foglio problematico, mostrando
> l'intervallo da essere evidenziata:
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
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
>
> ---
> Regards,
> Norman
>
saluti
eliano
Norman Jones ha scritto:
> Ciao 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
Norman Jones wrote
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?
> Regards,
> Norman
>
Grazie
Saluti
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.
---
Regards,
Norman
Norman Jones
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
> 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)
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.
?
> 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.
>
> ---
> Regards,
> Norman
>
grazie saluti
Norman Jones
> 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
> 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
> '<<=============
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?
>
>
> ---
> Regards,
> Norman
>
Grazie saluti
Norman Jones
> 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).
Non capisco in quanto, se la colonna fosse vuota, si uscirebbe dalla
procedura:
>> 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
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
no spam @email.it Marco
Norman Jones wrote
> 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:
Hai perfettamente ragione!; strano di solito Ctrl-C Ctrl-V mi riesce facile.
;-)
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: ?
> iCol = .Offset(0, 2).End(xlToRight).Column
Norman Jones
> 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: ?
>> 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
Norman Jones wrote
> Ciao Marco,
Ciao
>
> 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.
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. ?
>
>
> ---
> Regards,
> Norman
>
Grazie saluti
Ps Forse più rapido è eliminare le colonne vuote, al limite si possono
ricreare con già la colorazione.
Norman Jones
> 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
Norman Jones wrote
> Ciao Marco,
ciao
>
>> Ora mi metti in confusione
>
> Credo che io pensassi di un modello troppo complesso!
Chi è bravo supera sempre gli ostacoli. ;-)
>
> 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
Dim Rng2 As Range '<<=== è meglio fare tutto in una volta a questo punto
>
> 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
>
grazie
saluti
Norman Jones
> 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