Macro per la ricerca di Record

[thunder78]

Ho un elenco di dati con dei record doppi (ricavati tramite la formula "Se questo è uguale a questo... se vero "doppio", se falso "unico") che voglio scorrere tramite un pulsante che applica la funzione "Trova".

Ho provato ad associare la funzione a un pulsante ma quando eseguo nuovamente la macro si ferma sempre sullo stesso record.

Come faccio a fare una macro che mi trova tutte le doppie senza filtrarle ma solo scorrendole?

Grazie.

[Anthony47]

Ciao,
puoi postare la tua macro, cosi' partiamo da quella?

[thunder78]

Columns("B:B").Select
Selection.Find(What:="DOPPIO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Questo mi permette di trovare il primo record valorizzato con la dicitura "doppio". Associando questa macro ad un pulsante e cliccandoci su però si ferma sul primo doppio e non va sugli altri. Come faccio a fare un "trova successivo" e a ripeterlo più volte?

Grazie. Marco.

[Anthony47]

Il problema e' che ogni volta che parte, la macro dice "cominciamo da B1".

Ipotesi 1:

Codice: Seleziona tutto

Cells.Find(What:="DOPPIO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Questa non imposta in quale colonna cercare, quindi cerca su tutte le celle partendo da quella selezionata.

Ipotesi 2:

Codice: Seleziona tutto

If Selection.Rows.Count <> 65536 And Selection.Column <> 2 Then Columns("B:B").Select
Selection.Find(What:="DOPPIO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Questa al primo lancio imposta la ricerca sulla colonna B, ai lanci successivi mantiene selezione e cella attiva corrente.

Ti quadra? Ciao.

[thunder78]

Grande! Grazie mille.

Ciao. Marco.

[thunder78]

All'inizio funzionava ma adesso mi da il seguente errore:

Errore di run time 91

Variabile oggetto o variabile del blocco With non impostata

Devo fare qualche modifica?

[thunder78]

C'è nessuno??

[Anthony47]

Quale macro e in quale situazione ti da' errore?

Ciao.

[thunder78]

Ho usato la seconda, perchè la prima va a cercare il contenuto in qualsiasi altra cella del foglio di lavoro, mentre a me serve trovare il contenuto della colonna B.

Comunque adesso sembrerebbe essersi risolto da solo. E' strano che mi abbia dato un errore prima.

Approfitto per chiederti un'altra cosa. Se provo a utilizzare la stessa macro per la colonna C, cambiando il parametro di ricerca da "DOPPIO" a "NON GESTITO" mi da lo stesso errore di prima. Ecco la macro che mi hai fornito e che io ho modificato.

If Selection.Rows.Count <> 65536 And Selection.Column <> 2 Then Columns("C:C").Select
Selection.Find(What:="NON GESTITO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Devo corregere qualcosa?

Grazie. Marco.

[thunder78]

Ho cambiato la macro in questo modo:

Codice: Seleziona tutto

If Selection.Column <> 3 Then Columns("C:C").Select
Selection.Find(What:="NON GESTITO ", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

per la colonna B invece:

Codice: Seleziona tutto

If Selection.Column <> 2 Then Columns("B:B").Select
Selection.Find(What:="DOPPIO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

La prima per la colonna C funziona, per la B si ferma sempre al primo doppio e non va avanti.


Come mai?

[Anthony47]

Correzione, per la B:
If Selection.Rows.Count <> 65536 Or Selection.Column <> 2 Then Columns("B:B").Select

mentre per la C:
If Selection.Rows.Count <> 65536 Or Selection.Column <> 3 Then Columns("C:C").Select

Ciao.

[thunder78]

Ho provato ma la situazione non cambia. Dovrei essere in grado di spostarmi da una colonna all'altra con queste 2 macro, ma mentre quella della colonna C funziona, l'altra per la colonna B rimane ferma sul primo doppio.

Come si può fare?

Grazie. Marco.

[Anthony47]

Ho provato ma la situazione non cambia

Non cambia rispetto a che cosa? Posta per favore l' intera macro, cosi' vediamo meglio...

Ciao.

[thunder78]

Ecco la prima

Codice: Seleziona tutto

If Selection.Rows.Count <> 65536 Or Selection.Column <> 2 Then Columns("B:B").Select
Selection.Find(What:="DOPPIO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

e la seconda

Codice: Seleziona tutto

If Selection.Rows.Count <> 65536 Or Selection.Column <> 3 Then Columns("C:C").Select
Selection.Find(What:="NON GESTITO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Forse il problema si presente quando devi passare da una colonna all'altra per fare la ricerca?

Ricordo: la prima non funziona (si ferma sul primo doppio)
la seconda funziona!

[Anthony47]

Mi dovresti far vedere tutto il codice, dal titolo a End Sub.
Secondo me c' e' una istruzione che modifica la tua selezione, per cui Columns("B:B").Select e' eseguita ad ogni lancio della macro.

Ciao.

[thunder78]

Detto fatto:

MACRO PRINCIPALE

Codice: Seleziona tutto

Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Sheets("RIEPILOGO").Select
    Range("C9").Select
    Selection.ShowDetail = True
    ActiveSheet.Name = "detail"
    Range("A1").Select
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "detail!R1C1:R265C22").CreatePivotTable TableDestination:="", TableName:= _
        "Tabella_pivot1", DefaultVersion:=xlPivotTableVersion10
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("Tabella_pivot1").AddFields RowFields:= _
        """CHG:Task"".""Implementor Name+""", ColumnFields:="Category", PageFields _
        :=Array("Type", "Item")
    ActiveSheet.PivotTables("Tabella_pivot1").PivotFields( _
        """CHG:Task"".""Task ID+""").Orientation = xlDataField
    ActiveWorkbook.ShowPivotTableFieldList = True
    ActiveWorkbook.ShowPivotTableFieldList = False
    ActiveWindow.Zoom = 80
    ActiveSheet.Name = "Triplette HW-SW"
    Columns("A:H").Select
    Range("H1").Activate
    Columns("A:H").EntireColumn.AutoFit
    Range("C1").Select
    Sheets("detail").Select
    ActiveWindow.SelectedSheets.Delete
    Sheets("Triplette HW-SW").Select
    Range("C1").Select
    With ActiveSheet.PivotTables("Tabella_pivot1").PivotFields("Category")
        .PivotItems("(vuoto)").Visible = False
    End With
    Sheets("Triplette HW-SW").Select
    ActiveWorkbook.Sheets("Triplette HW-SW").Tab.ColorIndex = 45
    Sheets("Triplette HW-SW").Select
    Sheets("Triplette HW-SW").Move Before:=Sheets(1)
    ActiveSheet.Buttons.Add(424.5, 6, 72.75, 22.5).Select
    Selection.OnAction = "CHIUDIGIACTASK"
    ActiveSheet.Shapes("Button 3").Select
    Selection.Characters.Text = "CHIUDI"
    With Selection.Characters(Start:=1, Length:=6).Font
        .Name = "Arial"
        .FontStyle = "Grassetto"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 3
    End With
    Range("C1").Select
    ActiveSheet.Shapes("Button 3").Select
    ActiveSheet.Shapes("Button 3").Select
    Selection.Characters.Text = "CHIUDI"
    With Selection.Characters(Start:=1, Length:=6).Font
        .Name = "Arial"
        .FontStyle = "Grassetto"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = 5
    End With
    Range("C1").Select
    Application.ScreenUpdating = True

Prima macro di ricerca:

Codice: Seleziona tutto

If Selection.Rows.Count <> 65536 Or Selection.Column <> 2 Then Columns("B:B").Select
Selection.Find(What:="DOPPIO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Seconda macro di ricerca:

Codice: Seleziona tutto

 If Selection.Rows.Count <> 65536 Or Selection.Column <> 3 Then Columns("C:C").Select
Selection.Find(What:="NON GESTITO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

[thunder78]

Scusami ti ho incollato un'altra macro:

LA MACRO PRINCIPALE E' LA SEGUENTE:

Codice: Seleziona tutto

Application.ScreenUpdating = False
    Sheets("RIEPILOGO").Select
    Range("K9").Select
    Selection.ShowDetail = True
    ActiveSheet.Name = "Asset"
    Sheets("Asset").Select
    Sheets("Asset").Move Before:=Sheets(1)
    Columns("L:M").Select
    Selection.Cut
    Range("L1").Select
    Selection.End(xlToLeft).Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").Select
    Range("A1:U309").Sort Key1:=Range("A2"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortTextAsNumbers
    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Controllo"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]=R[1]C[-1],""DOPPIO"",""UNICO"")"
    Selection.Copy
    Range("B3:B750").Select
    ActiveSheet.Paste
    Columns("B:B").Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B1").Select
    Selection.AutoFilter
    Selection.AutoFilter Field:=1, Criteria1:="="
    Columns("B:B").Select
    Selection.ClearContents
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Controllo"
    Range("B309").Select
    Selection.AutoFilter Field:=1
    Selection.AutoFilter Field:=2, Criteria1:="DOPPIO"
    Rows("1:1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    Selection.Font.ColorIndex = 3
    Range("B1").Select
    Selection.AutoFilter Field:=2
    ActiveWindow.SmallScroll Down:=-3
    Rows("1:8").Select
    Selection.Insert Shift:=xlDown
    Selection.Interior.ColorIndex = 2
    Range("C4").Select
    ActiveCell.FormulaR1C1 = "=COUNTIF(C[-1],""DOPPIO"")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A4:B4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Asset Doppi trovati"
    Range("A4:B4").Select
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Range("C4").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("A4:C4").Select
    With Selection.Font
        .Name = "Arial"
        .Size = 14
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With Selection.Font
        .Name = "Arial"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    Selection.Font.Bold = True
    Selection.Font.ColorIndex = 11
    Range("C4").Select
    Selection.Font.ColorIndex = 3
    Range("A4:B4").Select
    ActiveSheet.GroupBoxes.Add(203.25, 15, 204.75, 75.75).Select
    Selection.Characters.Text = "AZIONI"
    ActiveSheet.OptionButtons.Add(211.5, 25.5, 165.75, 17.25).Select
    Selection.ShapeRange.IncrementLeft 9.75
    Selection.ShapeRange.IncrementLeft -11.25
    Selection.ShapeRange.IncrementTop -0.75
    ActiveSheet.Shapes("Option Button 26").Select
    Selection.Characters.Text = "TROVA ASSET DOPPI"
    Selection.OnAction = "ASSETFIND"
    ActiveSheet.OptionButtons.Add(208.5, 51.75, 171, 17.25).Select
    ActiveSheet.Shapes("Option Button 27").Select
    Selection.Characters.Text = "TROVA ASSET NON GESTITI"
    Selection.OnAction = "ASSETNG"
    Selection.ShapeRange.IncrementLeft 2.25
    Selection.ShapeRange.IncrementTop -7.5
    Selection.ShapeRange.IncrementLeft -0.75
    ActiveSheet.OptionButtons.Add(207.75, 69.75, 177.75, 17.25).Select
    ActiveSheet.Shapes("Option Button 28").Select
    Selection.Characters.Text = "CHIUDI"
    Selection.ShapeRange.IncrementLeft 6.75
    Selection.ShapeRange.IncrementTop -3.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementLeft -0.75
    Selection.ShapeRange.IncrementTop -0.75
    Selection.ShapeRange.IncrementTop -0.75
    Selection.ShapeRange.IncrementTop -0.75
    Selection.ShapeRange.IncrementTop 0.75
    Selection.ShapeRange.IncrementLeft 0.75
    Selection.OnAction = "CHIUDIGIACTASK"
    Range("B9").Select
    Cells.Select
    With Selection
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .ReadingOrder = xlContext
    End With
    Range("B9").Select
    Sheets("Asset").Select
    ActiveWorkbook.Sheets("Asset").Tab.ColorIndex = 4
    Rows("10:10").Select
    ActiveWindow.FreezePanes = True
    Application.ScreenUpdating = True

[Anthony47]

Scusa, continui a darmi dei pezzi di codice ma non vedo la macro di cui stavamo a parlare (dovrebbe cominciare con Sub xxxx, contenere le istruzioni quali If Selection.Rows.Count <> 65536 Or Selection.Column <> etc etc, e finire con End Sub).
Ho cercato anche di sollevarti il dubbio che la macro possa non funzionare perche' tra una sua esecuzione e l' altra selezioni un' altra cella, ma su questa ipotesi non dici niente; pero' sei l' unico che puo' saperlo.

La "macro principale" che hai allegato non so che cosa c' entra con il processo di "cerca/trova" da cui siamo partiti. Insomma non ho elementi su cui fare altre ipotesi.

Sorry...

[thunder78]

Allora ti spiego: la macro principale crea un foglio con un elenco di dati "esploso" da una tabella pivot la quale si collega a un'origine dati esterna. Sullo stesso foglio ho aggiunto delle righe (dalla 1 alla 10) per fare spazio ai due pulsanti che ho associato alle macro.

Chiaramente le macro che mi hai fornito e che ti ho elencato sopra iniziano con SUB e finiscono con END SUB, pure perchè non credo funzionino senza.

[thunder78]

Ok ho risolto.

per i doppi ho utilizzato questa macro:

Codice: Seleziona tutto

If Selection.Rows.Count <> 65536 Or Selection.Column <> 1 Then Columns("B:B").Select
Selection.Find(What:="DOPPIO", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

Praticamente, ho sostituito Selection.Column <> 2, inserendo 1, anche se i doppi da ricercare sono nella colonna B, quindi nella seconda.

quando clicco sul pulsante mi va sempre a selezionare le prime 2 colonne A e B, anche se questo non sembra interferire con il funzionamento della macro.

Ciao e grazie.