Discussione: Corso VBA
Visualizza messaggio singolo
Vecchio 08-09-2014, 01.18.30   #54
Alexsandra
Senior Member
WT Expert
 
L'avatar di Alexsandra
 
Registrato: 19-05-2007
Loc.: Verona
Messaggi: 1.302
Alexsandra č conosciuto da tuttiAlexsandra č conosciuto da tuttiAlexsandra č conosciuto da tuttiAlexsandra č conosciuto da tuttiAlexsandra č conosciuto da tutti
#1

Macro e Procedure varie riferite alle righe


=> Trovare l'ultima riga che contiene dati nella colonna A
Nota: Le seguenti routine riportano il numero dell’ultima riga contenente un valore
Codice:
Sub ultima_riga1()
    Dim UltimaR As Long
    With ActiveSheet
        UltimaR = .Cells(.Rows.count, "A").End(xlUp).Row
    End With
    MsgBox UltimaR
End Sub

'oppure

Sub ultima_riga2()
UltimaR = Range("A" & Rows.Count).End(xlUp).Row
MsgBox UltimaR
End Sub

'oppure

Sub ultima_riga3()
UltimaR = Cells(Rows.Count, 1).End(xlUp).Row
MsgBox UltimaR
End Sub

'oppure

Sub ultima_riga4()
UltimaR = Sheets("Foglio1").Range("A1").End(XlDown).Row
MsgBox UltimaR
End Sub
=> Trovare il valore dell'ultima cella
Nota: Questa routine riporta il valore presente nell’ultima riga contenente dati della colonna A
Codice:
Sub trova1()
ultima = [A1].End(xlDown) 
MsgBox ultima 
End Sub
=> Eliminare righe vuote
Nota: Alcune routine che scorrono la colonna A e cancellano le righe vuote
Codice:
Sub eliminaR1()
Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

'oppure

Sub eliminaR2()
Range("A:A").SpecialCells(xlCellTypeBlanks).Delete (xlShiftUp)
End Sub

'oppure

Sub EliminaR3()
Dim rng As Range, fgl As Boolean
Dim Righe, R
Set rng = ActiveSheet.UsedRange
Righe = rng.Rows.Count
For R = 1 To Righe
If rng(R, 1) = "" Then
rng(R, 1).EntireRow.Delete
End If
Next
End Sub

'oppure

Sub EliminaR4()
With ActiveSheet.UsedRange
rigaI = .Row + .Rows.Count - 1
End With
Application.ScreenUpdating = False
For R = rigaI To 1 Step -1
If Application.CountA(Rows(R)) = 0 Then Rows(R).Delete
Next R
End Sub
=> Cancellare le righe scelte
Nota: Inserendo il numero delle righe separato dalla virgola vengono cancellate le righe scelte
Codice:
 Sub test()
CancellaR "3,6,9"
End Sub

Sub CancellaR(myR As String)
Dim sR() As String, i As Long
sR = Split(myR, ",")
For i = UBound(sR) To LBound(sR) Step -1
Rows(sR(i)).Delete
Next
End Sub
=> Cerca e nasconde righe doppie
Codice:
Sub NascondiRD()
Dim cell As Range, nasc As Range, ult As Long
Application.ScreenUpdating = False
ult = Cells(Rows.count, 1).End(xlUp).Row
For i = ult To 2 Step -1
If Not IsError(Application.Match(Cells(i, 1).Value, _
Range("A1:A" & i - 1), 0)) Then
If nasc Is Nothing Then
Set nasc = Cells(i, 1)
Else: Set nasc = Union(nasc, Cells(i, 1))
End If
End If
Next i
If Not nasc Is Nothing Then _
nasc.EntireRow.Hidden = True
End Sub
=> Cancella le righe doppie
Codice:
 Sub Cancella_uguali()
Dim cell As Range, righeS As Range, rigaP As Long

Application.ScreenUpdating = False
rigaP = Cells(Rows.count, 1).End(xlUp).Row
For i = 1 To rigaP
If Cells(i, 1) = Cells(i + 1, 1) Then
If righeS Is Nothing Then
Set righeS = Cells(i + 1, 1)
Else: Set righeS = Union(righeS, Cells(i + 1, 1))
End If
End If
Next i
If Not righeS Is Nothing Then righeS.EntireRow.Delete
End Sub
=> Bloccare la prima riga di un foglio
Codice:
Sub Blocca_riga()
Rows("2:2").Select
ActiveWindow.FreezePanes = True
End Sub
=> Seleziona la riga della cella attiva
Codice:
Sub seleziona()
Range(ActiveCell.Address & ":" & ActiveCell.End(xlToRight).Address).Select
End Sub
=> Conoscere il numero di riga della cella attiva
Codice:
Sub riga1()
riga = ActiveCell.Row
MsgBox riga
End Sub
=> Contare le righe in un Range
Codice:
Sub conta_righe()
[A1].Select
ActiveCell.CurrentRegion.Select
conta = Selection.count
MsgBox "La selezione contiene " & Selection.Rows.count & " righe"
End Sub
=> Inserire una riga sotto la cella attiva
Codice:
Sub InserireS()
ActiveCell(2).Resize(1).EntireRow.Insert
End Sub
=> Selezionare varie righe
Codice:
Sub selezionaR()
Dim rg As String, lung As Integer, sel As Range
rg = InputBox("Inserisci il N° di righe che vuoi selezionare?")
'inserire il n° di riga nella forma 3,6,9
lung = Len(rg)
On Error Resume Next
selR = Application.WorksheetFunction.Search(",", rg, 1)
If selR = "" Then
Range(Cells(Left(rg, lung), 1), Cells(Left(rg, lung), 7)).Select
Else
selR = Application.WorksheetFunction.Search(",", rg, 1)
riga = Left(rg, selR)
rgLun = Len(riga)
Range(Cells(Left(riga, rgLun), 1), Cells(Left(riga, rgLun), 7)).Select
For i = 2 To lung
On Error Resume Next
selR = Application.WorksheetFunction.Search(",", rg, 1)
riga = Left(rg, selR)
rgLun = Len(riga)
Union(Selection, Range(Cells(riga, 1), Cells(riga, 7))).Select
rg = Mid(rg, rgLun + 1, lung)
Next i
End If
End Sub
___________________________________

- Il primo fondamento della sicurezza non e' la tecnologia, ma l'attitudine mentale -
Alexsandra non č collegato   Rispondi citando