Trovare stringa in colonna

Hai un problema con Excel?

Nuova discussione

Trovare stringa in colonna
di pf92 (utente non iscritto) data: 10/06/2014 10:58:32
Salve a tutti...avrei bisogno di un aiutino.
Ho realizzato un foglio di calcolo per fare dei preventivi.
Nel foglio "DB" un file "DATAtest.xls" ho il mio database, con ID-Categoria-Nome-Prezzo ecc.
Nel foglio "PREVENTIVO" del file "PREVENTIVI2013" ho un form per inserire un nuovo articolo nel database.

In sostanza vorrei che alla pressione del pulsante "ConfInsert" per la conferma dell'inserimento ci fosse un controllo che verifichi l'eventuale presenza di un articolo con lo stesso ID all'interno del database (colonna A:A), ovviamente per impedire di avere ID non univoci.

Il codice è sporco per le varie prove per cui una bella ripulita mi farebbe comodo! Grazie mille!!

PS:.il database viene aperto in background all'apertura del file PREVENTIVI2013

Private Sub ConfInsert_Click()
Dim sh As Worksheet
Dim rng As Range
Dim database As Workbook
Dim db As Worksheet

Set database = Workbooks("DATAtest.xls")
Set sh = database.Sheets("DB")
sh.Activate

If CodArt.Value = "" Then
        MsgBox ("INSERIRE UN CODICE ARTICOLO")
        InserisciArticolo.CodArt.SetFocus
Else
    sh.Activate
    With Workbooks("DATAtest.xls").Worksheets("DB")
    Set rng = [a:a].Find(CodArt, lookat:=xlWhole)
    MsgBox (rng)
    End With
    If rng Is Nothing Then
        MsgBox ("Codice già presente!")
        CodArt.SetFocus
    Else
        With sh 'assegno i valori delle textbox alle celle'
            .Unprotect "0000"
            .Range("a1").EntireRow.Insert
            .Range("a1").Value = InserisciArticolo.CodArt.Value
            .Range("b1").Value = InserisciArticolo.Categoria.Value
            .Range("c1").Value = InserisciArticolo.Nome.Value
            .Range("d1").Value = InserisciArticolo.ImpForn.Value
            .Range("e1").Value = InserisciArticolo.Impposa.Value
            .Range("f1").Value = InserisciArticolo.um.Value
            .Range("g1").Value = InserisciArticolo.Descforn.Value
            .Range("h1").Value = InserisciArticolo.Descfornposa.Value
             
            'Dim lng As Long 'FUNZIONE RIORDINA e inserisci riga
            'sh.Activate
            'sh.Select
            'Columns("A:H").Select
            'Selection.Sort Key1:=Range("b1"), Order1:=xlAscending, Key2:=Range("c1"), _
            'Order2:=xlAscending, Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
            'Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2:= _
            'xlSortNormal
            For lng = .Range("b" & .Rows.Count).End(xlUp).Row To 2 Step -1 'ciclo le celle interessate partendo dallultima
                If .Cells(lng, 2).Value <> .Cells(lng - 1, 2).Value Then 'se il contenuto della cella superiore è diverso
                 .Cells(lng, 2).EntireRow.Insert Shift:=xlDown 'inserisco una riga
                End If
            Next
       End With
    MsgBox ("Articolo inserito correttamente")
    End If
       
sh.Protect DrawingObjects:=False, Contents:=False, Scenarios:=False, AllowFormattingColumns:=True, AllowFormattingRows:=True

Set db = Nothing 'Set a Nothing delle variabili oggetto
Set database = Nothing
End If
End Sub

di Lucas87 data: 10/06/2014 12:15:23
Ciao
Vedi le istruzioni sotto
Porta la riga che mette la protezione al foglio dopo il messaggio "Articolo inserito correttamente"
Gli sh.activate non servono

SOSTITUISCI QUESTO

With Workbooks("DATAtest.xls").Worksheets("DB")
    Set rng = [a:a].Find(CodArt, lookat:=xlWhole)
    MsgBox (rng)
    End With
    If rng Is Nothing Then
        MsgBox ("Codice già presente!")
        CodArt.SetFocus

CON QUESTO

Set rng = sh.columns(1).Find(CodArt, lookat:=xlWhole)
    If not rng Is Nothing Then
        MsgBox ("Codice già presente!")
        CodArt.SetFocus
        exit sub

di pf92 (utente non iscritto) data: 17/06/2014 14:15:01
Grazie mille Lucas87...funziona...... e se volessi fare una sub per modificarlo anzichè inserirlo?
di Lucas87 data: 17/06/2014 16:16:27
Ciao
Nell'esempio sotto uso due inputbox per chiedere il vecchio e il nuovo codice; tu devi impostare il form a dovere, ad esempio con 2 textbox
vecchio = InputBox("vecchio") nuovo = InputBox("nuovo") Set fin = Columns(1).Find(what:=vecchio, lookat:=xlWhole) If Not fin Is Nothing Then fin.Value = nuovo End If

Vuoi Approfondire?