› Sviluppare funzionalita su Microsoft Office con VBA › Info VBA
-
AutoreArticoli
-
Ciao a tutti
In colonna A ci sono dei nomi-duplicati, in colonna B ci sono dei nomi-duplicati.
Il Nome_1 & Nome_2 sulla stessa riga sono univoci (non esistono due righe con stesso Nome_1 & Nome_2).Di norma ho sempre aggiunto una colonna, inserendo la formula =concatena(A1;B1) e cercavo (tramite FIND) in quale riga ci fosse questo "binomio". Senza usare la colonna d'appoggio, come fareste Voi a trovare tale riga? Un metodo migliore del mio.... Grazie mille
Ciao @raffaele53, puoi allegare un file di esempio e il risultato da ottenere?
ciao,
con i nomi nelle colonne A e B, viene emesso un msgbox indicante la riga in cui sono presenti i nomi cercati, puoi facilmente sostituire le msgbox con assegnazione valore riga in una cella
I nomi da cercare li ho scritti nel codice, meglio sarebbe prelevarli da 2 celle a piacere
Il codice è ottimizzato nel caso ci siano moltissime righe contenenti i nomi, in caso contrario si può semplificare notevolmente
Sub CercaNomi() Dim n1 As String, n2 As String, firstaddress As String, r As Integer, c As Range n1 = "nome2": n2 = "nome3" r = Range("A" & Rows.Count).End(xlUp).Row Set c = Range("A1:A" & r).Find(n1, LookIn:=xlValues, lookat:=xlWhole) If Not c Is Nothing Then If Cells(c.Row, "B") = n2 Then MsgBox "nomi in colonna " & c.Row Exit Sub Else firstaddress = c.Address Do Set c = Range("A1:A" & r).FindNext(c) If Cells(c.Row, "B") = n2 Then MsgBox "nomi in colonna " & c.Row Exit Sub End If Loop While firstaddress <> c.Address End If End If MsgBox "nessuna coppia di nomi trovata" End Subtanto per gradire, altra soluzione
`Sub CercaNomi() Dim r As Integer, stringa As String, nomi As String, NomiConc As Variant, i As Long nomi = "nome4" & "nome1" r = Range("A" & Rows.Count).End(xlUp).Row NomiConc = Evaluate("A1:A" & r & " & B1:B" & r) stringa = Join(Application.Transpose(NomiConc), vbCrLf) If InStr(stringa, nomi) > 0 Then For i = 1 To UBound(NomiConc) If NomiConc(i, 1) = nomi Then MsgBox "Nomi Trovati alla riga: " & i Exit Sub End If Next i Else MsgBox "Non trovato" End If End Sub`@lukereds
Perfetto, complimenti e grazieLa mia era solo una domanda per conoscere il metodo migliore e veloce:
1) Con colonna d'appoggio sarebbe bastato una sola operazione (WorksheetFunction.Match)
2) Ciclo For sarebbero Max 381 operazioni + 381 verifiche
3) Tramite FIND sarebbero Max 18 operazioni + 18 verifichePossibile che non ci siano altri metodi più snelli? Nell'allegato ho ricreato un esempio tramite campionato di calcio-2025, quando arriverà il momento d'inserire i risultati bisognerà prima trovare in quale riga esiste la partita.
Ps. Il metodo di @lukereds lo trovo molto valido e per il momento il più veloce.
PPs. Stavo rispondendo quando ho visto l'ultimo codice che sembrava interessante. Dopo ho intravisto che prima crei una lista e secondo me sono troppe le operazioni (forse sbaglio ma non mi da la risposta)Allegati:
You must be logged in to view attached files.forse sbaglio ma non mi da la risposta
Hai dimenticato di valorizzare la variabile "nomi"
... n1 = Range("E1"): n2 = Range("G1") nomi = n1 & n2 '<------- r = Range("E" & Rows.Count).End(xlUp).Row ...Altro metodo
Sub CercaIncontro() Dim i As Long For i = 2 To Cells(Rows.Count, "E").End(xlUp).Row If Range("E" & i).Value & Range("G" & i).Value = Range("E1").Value & Range("G1").Value Then MsgBox "Trovato alla riga: " & i Exit Sub End If Next i MsgBox "Non trovato" End Subse hai decine o centinaia di migliaia di nomi, la soluzione è: power query, con i nomi delle tabelle indicati in figura
let Origine = Excel.CurrentWorkbook(){[Name="nomi"]}[Content], indice = Table.AddIndexColumn(Origine, "Indice", 1, 1, Int64.Type), ricerca = Excel.CurrentWorkbook(){[Name="ricerca"]}[Content], filtro1 = Table.SelectRows(indice, each ([n1] = ricerca[nome1]{0})), filtro2 = Table.SelectRows(indice, each ([n1] = ricerca[nome2]{0})), RimCol = Table.SelectColumns(filtro2,{"Indice"}), Indice = RimCol{0}[Indice] in IndiceSe invece hai povhi nomi è sufficiente
Sub nomi() Dim i As Integer, x i = 1: x = Evaluate("A1:A100&B1:B100") Do While Cells(i, 1) <> "" If "nome5" & "nome8" = x(i, 1) Then MsgBox "riga " & i: Exit Sub End If i = i + 1 Loop MsgBox "nomi non trovati" End SubAllegati:
You must be logged in to view attached files. -
AutoreArticoli
