Moderatori: Anthony47, Flash30005
M@rtyn@ ha scritto:Buongiorno a tutti, ho bisogno di aiuto con excel, devo tovare la prima cella con il valore uguale a quella attiva e contare le righe che le separano, potete aiutarmi ad automatizzare questo passaggio?
M@rtyn@ ha scritto:La casella da selezionare può essere su qualsiasi delle colonne.
Sono riuscita ad accelerare un pò usando la formula =RIGHE(B1:E13) al posto della calcolatrice, anche se conta una riga in più non è un dramma, basta saperlo che nel conteggio è incluso anche il giorno di partenza.
Però non è una grossa spinta.
Spero di essere stata chiara e di non aver fatto troppa confusione con un eccesso di informazioni.
Ciao Baci.
Public Sub ContaRighe()
Dim risultato, valore
Dim found As Range
valore = ActiveCell
Set found = ActiveSheet.UsedRange.Find(valore)
risultato = found.Row - ActiveCell.Row
MsgBox "Valore in: " & ActiveCell.Address & "=" & ActiveCell & Chr(13) & _
"Trovato in: " & found.Address & Chr(13) & _
"Differenza di righe = " & risultato
End Sub
Sub Trova()
URR = Range("B" & Rows.Count).End(xlUp).Row
Riga = ActiveCell.Row
VS1 = ActiveCell
With Range("B2:I" & URR)
Set C = .Find(VS1, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
RC = C.Row
Do
Set C = .FindNext(C)
If firstAddress = C.Address Then Exit Do
RV1 = C.Row - ActiveCell.Row
Range("K" & Riga).Value = RV1
GoTo esci
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
esci:
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
URR = Range("B" & Rows.Count).End(xlUp).Row
CheckArea = "B2:I" & URR
If Not Application.Intersect(ActiveCell, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
Application.EnableEvents = False
Call Trova
Application.EnableEvents = True
End If
End Sub
...
If firstAddress = C.Address Then Exit Do '<<<< esistente
RV1 = C.Row - ActiveCell.Row '<<<< esistente
If RV1 > 0 then '<<<< Aggiungere
Range("K" & Riga).Value = RV1 '<<<< esistente
End If '<<<< Aggiungere
...
Sub Trova()
URR = Range("B" & Rows.Count).End(xlUp).Row
Riga = ActiveCell.Row
VS1 = ActiveCell
With Range("B2:I" & URR)
Set C = .Find(VS1, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
RC = C.Row
Do
Set C = .FindNext(C)
If firstAddress = C.Address Then Exit Do
RV1 = C.Row - ActiveCell.Row
If RV1 > 0 Then
Range("K" & Riga).Value = RV1
GoTo esci
End If
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
esci:
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
URR = Range("B" & Rows.Count).End(xlUp).Row
CheckArea = "B2:I" & URR
If Not Application.Intersect(ActiveCell, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
'Application.EnableEvents = False '<<<<<<<<<<<<<<<<<< elimina o commenta
Call Trova
'Application.EnableEvents = True '<<<<<<<<<<<<<<<<<< elimina o commenta
End If
End Sub
Sub Trova()
URR = Range("B" & Rows.Count).End(xlUp).Row
Riga = ActiveCell.Row
VS1 = ActiveCell
With Range("B2:I" & URR)
Set C = .Find(VS1, LookIn:=xlValues, LookAt:=xlWhole)
If Not C Is Nothing Then
firstAddress = C.Address
RV1 = C.Row - ActiveCell.Row
If RV1 > 0 Then
Range("K" & Riga).Value = RV1
GoTo esci
End If
Do
Set C = .FindNext(C)
If firstAddress = C.Address Then Exit Do
RV1 = C.Row - ActiveCell.Row
If RV1 > 0 Then
Range("K" & Riga).Value = RV1
GoTo esci
End If
Loop While Not C Is Nothing And C.Address <> firstAddress
End If
End With
esci:
End Sub
Torna a Applicazioni Office Windows
Macro che ricerca combinazioni che danno un valore Autore: kar64 |
Forum: Applicazioni Office Windows Risposte: 10 |
Inserimento valore di una cella in testo di altra cella Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 75 ospiti