Risolto VBA cerca corrispondenza e aumenta di 1

[matte.u]

Ciao sono un novellino di Excel e VBA sto cercando di imparare ma non è facile
sto facendo un file per gestire delle tessere a punti per ogni determinato utente, Ogni utente ha la sua tessera con codice a barre, che verrà associata all'utente con un anagrafica utilizzando le userform, ed una pistola per barcode (GIA CREATO)
successivamente devo creare un file dove utilizzando la pistola barcode che mi trascrive un codice numerico in una cella mi cerca quel valore nell anagrafica e mi restituisce ogni volta un +1 a fianco del valore trovato fino ad arrivare a 10, arrivato a 10 ho bisogno che mi appaia un messaggio.
Ho provato in vba ad utilizzare il find e dando delle variabili ma non so fare a dirgli se lo trovi metti al fianco del valore +1
Non so se mi sono spiegato, potrei provare ad allegare il file ma così com'è non credo che sia di aiuto
Grazie mille

 

[alfrimpa]

potrei provare ad allegare il file ma così com'è non credo che sia di aiuto

Invece lo è ed allega pure i tuoi tentativi di scrittura del codice che hai fatto in modo che ti si possa dire se e dove hai sbagliato

 

[matte.u]

sono in alto mare non so come iniziare avevo preso spunto da un tutorial ma non fa quello che vorrei, sono fermo a dove vedete nel file.

 

[Terio]

Integra il tuo codice:

Sub CercaeAumenta()

    Dim lista As Range
    Dim cerca As Range
    
    Set lista = Range("A2", Range("A2").End(xlDown))
    
    Set cerca = lista.Find(Range("F14").Value)

    If Not cerca Is Nothing Then
        If cerca.Offset(, 1).Value >= 10 Then
            MsgBox "Valore raggiunto", vbCritical, "Attenzione!"
        Else
            cerca.Offset(, 1).Value = cerca.Offset(, 1).Value + 1
        End If
    End If

End Sub

Ciao.

 

[Marco Lauria]

Ciao Terio mi hai preceduto
alternativa:

Sub CercaeAumenta()
    Dim lista As Range
    Dim cerca As Range
    
    Set cerca = Worksheets("movimentazione").Range("F14")
    For Each lista In Worksheets("movimentazione").Range("A2", Range("A2").End(xlDown))
        If lista = cerca Then
            lista.Offset(0, 1) = lista.Offset(0, 1) + 1
            If lista.Offset(0, 1) = 10 Then MsgBox "Sei arrivato a 10!!"
        End If
    Next lista
End Sub

 

[Alexps81]

Ciao @matte.u

siccome dici che stai cercando di imparare, hai già ottenuto 2 valide soluzione (con FIND e ciclo FOR), te ne propongo un'altra con Application.Match

Adesso hai tre soluzioni da studiare e scoprire quale si addice meglio al tuo obiettivo. Ad esempio, se avessi codici non univoci, Application.Match non andrebbe bene. Ma nel tuo caso credo che i codice siano per forza univoci.

Option Explicit

Sub cercaCodiceCliente()
    Dim codice As Variant, codDaCercare As Variant
    
    codice = Range("F14").Value
    codDaCercare = Application.Match(codice, Range("A:A"), 0)
    
    If Not IsError(codDaCercare) Then
        If Cells(codDaCercare, "B").Value < 10 Then
           Cells(codDaCercare, "B").Value = Cells(codDaCercare, "B").Value + 1
        Else
            MsgBox "Hai raggiunto già 10 punti!", vbExclamation, "Attenzione"
            Exit Sub
        End If
    End If
End Sub

 

[triskell]

ciao.
Altra ipotesi usando match

Sub CercaeAumenta()

    Dim lista As Range
    Dim codice As Range
    Dim riga As Long
    Dim WS As Worksheet
    
    Set WS = Sheets("Movimentazione")
    Set lista = WS.Range("A:A").SpecialCells(2)
    Set codice = WS.Range("f14")

riga = Application.WorksheetFunction.Match(codice, lista)
If WS.Cells(riga, 2) = 10 Then MsgBox "Abbasta": Exit Sub
WS.Cells(riga, 2) = WS.Cells(riga, 2) + 1

    Set WS = Nothing
    Set lista = Nothing
    Set codice = Nothing

End Sub

@Alexps81 .. perdonami.. Abbiamo fatto un frontale

 

[lukereds]

ciao,
n+1 esimo codice. IN caso di n mila clienti aumenta il 1000 in riga 2 al numero che serve

Sub punti()
Dim c As Range
Set c = Range("A2:A1000").Find(Range("F14"), LookAt:=xlWhole)
If Not c Is Nothing Then
   Cells(c.Row, 2) = Cells(c.Row, 2) + 1
   If Cells(c.Row, 2) = 10 Then MsgBox "cliente " & Range("F14") & " ha 10 punti"
End If
End Sub

 

[matte.u]

ragazzi che dire senza parole, non pensavo ad un aiuto cosi massivo, siete una gran forum. Ho provato tutte le varie opzioni che mi avete fornito e sono tutte perfette, i codici un po piu' lunghini riesco a capirlo meglio, quelli piu corti ho ancora da studiare e TANTO.
volevo provare ad integrare il codice dove una volta che arrivava a 10 oltre che al messaggio dove per chiuderlo devo cliccare obbligatoriamente "OK" (il quale è perfetto) poi mi si azzerasse in automatico il valore della cella da 10 ritornasse vuota oppure zero,
Ho provato dei codici come il

Sub DeleteCells()

     'Loop through cells XX:XX and delete cells that contain an "10."
     For Each c in Range("XX:XX")
        If c = "10" Then c.EntireRow.Delete
    Next

End Sub

oppure

"Range("xx").Value = (Range("xx").Value + 1) Mod 11

Ma non funzionano abbinate ad un codice piu' complesso solo a fine se stesse riesco a farle funzionare.

 

[Terio]

ragazzi che dire senza parole, non pensavo ad un aiuto cosi massivo, siete una gran forum

Grazie

Ho provato tutte le varie opzioni che mi avete fornito e sono tutte perfette, i codici un po piu' lunghini riesco a capirlo meglio, quelli piu corti ho ancora da studiare e TANTO.

Per quello sono rimasto sul tuo codice, affinché tu potessi comprenderlo meglio, a dispetto di quale sceglierai da usare, non esitare a chiedere spiegazioni per le parti meno chiare.

volevo provare ad integrare il codice dove una volta che arrivava a 10 oltre che al messaggio dove per chiuderlo devo cliccare obbligatoriamente "OK" (il quale è perfetto) poi mi si azzerasse in automatico il valore della cella da 10 ritornasse vuota oppure zero,

Per non andare OT, non devi cancellare la riga se il risultato che vuoi è quanto descritto, basta .ClearContents, ma non vado oltre, altrimenti è un'altra discussione.

Ciao.

 

[matte.u]

se il risultato che vuoi è quanto descritto, basta .ClearContents, ma non vado oltre, altrimenti è un'altra discussione.

Ho provato a fare una cosa un po' rudimentale del tipo:

If Range("B2").End(xlDown) = "10" Then
    Range("B2").End(xlDown).ClearContents
    
    End I

e funziona

 

[Terio]

funziona

ho qualche dubbio, ma, ripeto, non vado oltre.

Se hai risolto ricorda di chiudere la discussione,
ciao.

 

[matte.u]

ho qualche dubbio, ma, ripeto, non vado oltre.

Se hai risolto ricorda di chiudere la discussione,
ciao.

Pensavo che aprire troppi post non fosse carino, ma giustamente questo era in riferimento sola al cerca e +1 e non alle varie problematiche di tutto il file.
aprirò un nuovo post per altre necessita grazie mille a tutti

 

[Marco Lauria]

Modifica questa riga:

If lista.Offset(0, 1) = 10 Then MsgBox "Sei arrivato a 10!!"

in:

If lista.Offset(0, 1) = 10 Then
   MsgBox "Sei arrivato a 10!!"
   lista.Offset(0, 1) = ""
End If

 

[matte.u]

If lista.Offset(0, 1) = 10 Then
MsgBox "Sei arrivato a 10!!"
lista.Offset(0, 1) = ""
End If

quando mi dici di sostituire questo, ho provato ma mi da errore :

Sub CercaeAumenta()
    Dim lista As Range
    Dim cerca As Range
    
    Set cerca = Worksheets("movimentazione").Range("F14")
    For Each lista In Worksheets("movimentazione").Range("A2", Range("A2").End(xlDown))
        If lista = cerca Then
            lista.Offset(0, 1) = lista.Offset(0, 1) + 1
            If lista.Offset(0, 1) = 10 Then
   MsgBox "Sei arrivato a 10!!"
   lista.Offset(0, 1) = ""
End If
    Next lista
End Sub

 

[triskell]

Io non schiferei un'uscita dalla sub..

 

[Terio]

ho provato

Siamo OT, per cortesia fermiamoci qui,
grazie.

 

[Marco Lauria]

a me funziona benissimo!!!!!

Sub CercaeAumenta()
    Dim lista As Range
    Dim cerca As Range
    
    Set cerca = Worksheets("movimentazione").Range("F14")
    For Each lista In Worksheets("movimentazione").Range("A2", Range("A2").End(xlDown))
        If lista = cerca Then
            lista.Offset(0, 1) = lista.Offset(0, 1) + 1
            If lista.Offset(0, 1) = 10 Then
                MsgBox "Sei arrivato a 10!!"
                lista.Offset(0, 1) = ""
            End If
        End If
    Next lista
End Sub

 

[Terio]

per cortesia fermiamoci qui

+1

Grazie