Risultati da 1 a 3 di 3

Discussione: Cerca un record in almeno una colonna ed estrai quella riga una sola volta..?



  1. #1
    L'avatar di Kogenta
    Clicca e Apri
    Data Registrazione
    Feb 2016
    Località
    Italia
    Messaggi
    2
    Versione Office
    Office 2016
    Likes ricevuti
    0
    Likes dati
    0

    Cerca un record in almeno una colonna ed estrai quella riga una sola volta..?

    Ciao a tutti, ho un foglio con 20 colonne e più di 500 righe e devo estrarre solo certe celle di ogni riga in base ad un record che immetto tramite inputbox. Il problema è che ho tre colonne che sulla stessa riga possono ripetere tutte il mio record, e vorrei evitare che mi duplichi le righe. Inoltre non mi serve estrarre tutta la riga, ma solo celle che si trovano in colonne specifiche. Esempio

    ColA ColB ColC ColD ColE ColF ColG

    nome tipo forma ext genere genere genere
    nome tipo forma ext genere genere1 genere1
    nome tipo forma ext genere1 genere genere
    nome tipo forma ext genere1 genere genere
    nome tipo forma ext genere1 genere1 genere1
    nome tipo forma ext genere genere genere

    Io devo estrarre in un nuovo foglio solo le righe dove compare genere1, ma senza duplicarla se la trova più volte sulla stessa riga... inoltre mi servirebbe estrarre solo il valore delle colonne A e D insieme a E, F e G... E' possibile?

    Questo è il codice che cui sto partendo, ma ovviamente, usando l'offset della cella, ogni volta mi estrae celle diverse in base a dove trova il record :236:


    Codice: 
    Sub CercaRecord()
    Dim Rng As Range, cell As Object, riga As Long, colonna As Long, nome As Variant, numero As String, due As String, tre As String, quattro As String
    Set Rng = Sheets("ok").Range("A1:F191")
    riga = 5
    colonna = 2
    nome = Application.InputBox("", "Inserire nome", "")
    If nome <> False Then
    Sheets.Add.Name = nome
    With Rng
    For Each cell In .Cells
    If cell.Value = nome Then
    numero = cell.Offset(0, 2).Value
    numerodue = cell.Offset(0, 4).Value
    numerotre = cell.Offset(0, 7).Value
    numeroquattro = cell.Offset(0, 8).Value
    
    
    Sheets(nome).Cells(riga, 4) = cell.Value
    Sheets(nome).Cells(riga, 5) = numero
    Sheets(nome).Cells(riga, 6) = due
    Sheets(nome).Cells(riga, 7) = tre
    Sheets(nome).Cells(riga, 8) = quattro
    riga = riga + 1
    End If
    Next
    Grazie in anticipo :43:
    Ultima modifica fatta da:cromagno; 01/03/16 alle 18:39 Motivo: Inserito codice tra i tag CODE...

  2. #2

    L'avatar di cromagno
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Sardegna
    Età
    37
    Messaggi
    4028
    Versione Office
    2013
    Likes ricevuti
    1232
    Likes dati
    925
    Ciao Kogenta,
    dovresti allegare un file di esempio (spiegando quello che vuoi fare riferendoti a questo file) per capire quale potrebbe essere una soluzione valida.

    P.S.
    I codici dovresti inserirli tra i tag "CODE" (icona con il cancelletto #) non "QUOTE".

    "Sono le persone che nessuno immagina che possano fare certe cose, quelle che fanno cose che nessuno può immaginare."

  3. #3
    L'avatar di A.Maurizio
    Clicca e Apri
    Data Registrazione
    Aug 2015
    Località
    Torino
    Età
    56
    Messaggi
    383
    Versione Office
    2013
    Likes ricevuti
    44
    Likes dati
    0
    Ciao Kogenta ascolta visto che Cromagno ti ha invitato ad inserire il tuo Progetto , e tu non lo fai per chissa qual motivo !
    Io ti ofro comunque il mio Supporto dovrai solo fare in modo di Modificarlo e renderlo più consono al tuo foglio di lavoro .
    Ciao

    Codice: 
    Option Explicit
    Dim CL
    Dim Riga
    Dim Cell
    Dim Zonac
    Dim Dimmi
    Dim N As String
    Dim X As Integer
    Dim Y As Integer
    Dim Z As Integer
    Option Compare Text
    Public Ro As Integer
    Dim MyChar
    Dim CampoRicerca As String
    
    
    Private Sub Cmd_AzzeraTutto_Click()
    On Error Resume Next
    Foglio3.Range("J3").Interior.ColorIndex = 5
    Foglio3.Range("J3").Font.ColorIndex = 2
    
    
    Foglio3.Range("B6:K15").Interior.ColorIndex = 2
    Foglio3.Range("B6:K15").Font.ColorIndex = 1
    
    
    Foglio3.Range("B1").Value = ""
    Foglio3.Range("D1").Value = ""
    Foglio3.Range("J3").Value = "0"
    End Sub
    
    
    Private Sub Cmd_VerificaDato_Click()
    On Error Resume Next
    X = Val(Foglio3.Range("B1").Value)
    Y = Val(Foglio3.Range("D1").Value)
    Z = X * Y
    
    
    If Foglio3.Range("J3").Value = Z Then
    Foglio3.Range("J3").Interior.ColorIndex = 4
    Foglio3.Range("J3").Font.ColorIndex = 1
    Else
    Foglio3.Range("J3").Interior.ColorIndex = 3
    Foglio3.Range("J3").Font.ColorIndex = 2
    End If
    
    
    CL.Interior.ColorIndex = 3
    CL.Font.ColorIndex = 2
    
    
    Trova_Numero
    End Sub
    
    
    Function Rimuovi()
    N = Foglio3.Range("CampoRicerca").Text - 1
    If N >= 0 Then
    For Z = N To 0 Step -1
    Foglio3.Range(CampoRicerca).Value = Z
    Next Z
    End If
    End Function
    
    
    Sub Trova_Numero()
    On Error Resume Next
    Rimuovi
    For Each Cell In Range("B6:K15")
    If Cell.Value = Foglio3.Range("CampoRicerca").Text Then
    
    Cell.Offset(14, 1).Value
    End If
    Next
    Tasto_Click
    End Sub
    
    
    Sub Tasto_Click()
    On Error Resume Next
    'If OptionButton1.Value = True Then
    Foglio3.Range("B6:K15").Sort Key1:=Foglio3.Range("B6"), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
    xlTopToBottom
    
    
    '###########################################################################################
    If Foglio3.Range("CampoRicerca").Text = "" Then
    MsgBox "Devi Scrivere Cosa Cercare"
    Exit Sub
    End If
    
    
    '###########################################################################################
    Dim CL As Object
    'If OptionButton1.Value = True Then
    For Each CL In Sheets(3).Range(Cells(1, 1), Cells(1, 1).End(xlDown))
    If CL.Value = Foglio3.Range("CampoRicerca").Value Then
    Ro = CL.Row
    Exit For
    End If
    Next
    
    
    '############################################################################################
    'If CheckBox1.Value = 0 Then Exit Sub
    X = Sheets(3).[B6].End(xlDown).Row
    Set Zonac = Sheets(3).Range("B6:K" & X & "")
    Dimmi = Foglio3.Range("CampoRicerca").Value
    If Dimmi = "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z" Then Exit Sub
    For Each CL In Zonac
    
    
    If CL.Value Like "*" & Dimmi & "*" Then
    CL.Select
    Ro = CL.Row
    
    
    Dim idomanda As Integer
    idomanda = MsgBox("Trovato " & CL.Value & " ", vbYesNo)
    If idomanda = vbYes Then
    
    
    CL.Interior.ColorIndex = 3
    CL.Font.ColorIndex = 2
    
    
    X = Val(Foglio3.Range("B1").Value)
    Y = Val(Foglio3.Range("D1").Value)
    Z = X * Y
    Z = CL
    
    
    If Z = CL Then
    
    
    End If
    
    
    Exit Sub
    End If
    End If
    Next
    MsgBox "Inserire un Numero Valido"
    End Sub
    Ultima modifica fatta da:cromagno; 03/03/16 alle 19:20 Motivo: Inserito codice tra i tag CODE...

Discussioni Simili

  1. [Risolto] Mettere Valori di una tabella in una sola colonna
    Di AminTheWise nel forum Domande su Excel in generale
    Risposte: 5
    Ultimo Messaggio: 25/02/17, 16:07
  2. [Risolto] Possibilità di stampare più grafici in pdf in una volta sola
    Di Catwoman nel forum Domande sui Grafici di Excel
    Risposte: 13
    Ultimo Messaggio: 08/08/16, 15:08
  3. Cerca vert che restituisca più valori in una sola cella
    Di Mr_Dirupo nel forum Domande su Excel in generale
    Risposte: 19
    Ultimo Messaggio: 28/06/16, 19:12
  4. Risposte: 5
    Ultimo Messaggio: 17/05/16, 11:25
  5. estrai ed ordina numeri (solo una volta)
    Di Andre81 nel forum Domande su Excel in generale
    Risposte: 2
    Ultimo Messaggio: 23/07/15, 17:20

Permessi di Scrittura

  • Tu non puoi inviare nuove discussioni
  • Tu non puoi inviare risposte
  • Tu non puoi inviare allegati
  • Tu non puoi modificare i tuoi messaggi
  •