Ciao a tutti avrei bisogno di un aiuto per creare un codice in VBA in Excel per una ricerca in automatico di numeri

Question

Ciao a tutti,

Ho bisogno di un aiuto per creare un codice VBA in excel che esegua una ricerca 

mi spiego meglio:

ho un folgio di numeri ( inseriti in 3 colonne B, C,D ) con un numero di righe che varia a secondo dei dati inseriti.

Io devo cercare in questo foglio in automatico una combinazione di 2 o 3 numeri ( compresi tra 1 e 30 ) che si ripetono nelle stessa riga ( su un numero massimo di 5000 righe).

una volta individuate le combinazioni devono essere copiate su un altro foglio indicando nella colonna A e B e C i numeri , nella colonna D  il numero totale delle righe in cui sono presenti.

Grazie

Answer 1

Ciao Massimo,

Ho bisogno di un aiuto per creare un codice VBA in excel che esegua una ricerca 

mi spiego meglio:

ho un folgio di numeri ( inseriti in 3 colonne B, C,D ) con un numero di righe che varia a secondo dei dati inseriti.

Io devo cercare in questo foglio in automatico una combinazione di 2 o 3 numeri ( compresi tra 1 e 30 ) che si ripetono nelle stessa riga ( su un numero massimo di 5000 righe).

una volta individuate le combinazioni devono essere copiate su un altro foglio indicando nella colonna A e B e C i numeri , nella colonna D  il numero totale delle righe in cui sono presenti.

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim arrIn As Variant, arrOut() As Variant, arrNumeri As Variant

    Dim arrRiga As Variant

    Dim Res As Variant, Res2 As Variant

    Dim i As Long, j As Long, k As Long, iCtr As Long

    Dim iRow As Long, jRow As Long

    Dim bMatch As Boolean

    Const sFoglio_Sorgente As String = "Foglio1"              '<<=== Modifica

    Const sFoglio_Destinazione As String = "Foglio2"       '<<=== Modifica

    Res = Application.InputBox( _

          Prompt:="Inserire two o tre numeri separati da un trattino", _

          Type:=2, _

          Title:="NUMERI DA CERCARE")

    arrNumeri = Split(Res, "-")

    Set WB = ThisWorkbook

    With WB

        Set srcSH = .Sheets(sFoglio_Sorgente)

        Set destSH = .Sheets(sFoglio_Destinazione)

    End With

    With srcSH

        iRow = LastRow(srcSH, .Columns("A:A"))

        Set srcRng = .Range("B2:D" & iRow)

          arrIn = srcRng.Value

    End With

    With destSH

        jRow = LastRow(destSH, .Columns("A:A"))

        Set destRng = .Range("A" & jRow + 2)

    End With

    For i = 1 To UBound(arrIn)

        arrRiga = Application.Index(arrIn, i, 0)

        For j = 0 To UBound(arrNumeri)

            Res2 = Application.Match(CLng(arrNumeri(j)), arrRiga, 0)

            bMatch = Not IsError(Res2)

            If Not bMatch Then Exit For

        Next j

        If bMatch Then

            iCtr = iCtr + 1

            ReDim Preserve arrOut(1 To 4, 1 To iCtr)

            For k = 1 To UBound(arrNumeri) + 1

                arrOut(k, iCtr) = arrIn(i, k)

            Next k

            arrOut(4, iCtr) = "Tabella Riga: " & i

        End If

    Next i

    arrOut = Application.Transpose(arrOut)

    destRng.Resize(iCtr, 4).Value = arrOut

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1, _

                        Optional sPassword As String)

    Dim bProtected As Boolean

    With SH

        If Rng Is Nothing Then

            Set Rng = .Cells

        End If

        bProtected = .ProtectContents = True

        If bProtected Then

            .Unprotect Password:=sPassword

        End If

    End With

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

    If bProtected Then

        SH.Protect Password:=sPassword, _

                   UserInterfaceOnly:=True

    End If

End Function

'<<=========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester
• Esegui

===

Regards,

Norman

Answer 2

Ciao Massimo,

sto eseguendo la prova , ma uno damanda non si riesci a fare in modo che il VBA cerca in automatico i numeri senza inserirli in :

    Res = Application.InputBox( _

          Prompt:="Inserire two o tre numeri separati da un trattino", _

          Type:=2, _

          Title:="NUMERI DA CERCARE")

Certamente, a condizione di informare VBA - o me - quali sono i  2 o 3 numeri ( compresi tra 1 e 30 ) :-)

===

Regards,

Norman

Answer 3

ciao Norman,

Lo scopo è io acquisisco durante la registrazione dei dati numerici , in formato .TXT dove importandoli in excel mi trovo nella colonna A il tempo nelle colonne B,C,D,E,F,G i dati nel foglio 1 chiamato DATI.

Da li devo individuare le ripetizioni dei numeri a prescindere dall'ordine che può essere 15-3 o 3-15 e cosi via , n modo poi da averli su il foglio 2 chiamato CONTROLLO , in modo che io poi possa procedere alla ricalibrazione più velocemente suddiviso in colonna A =punti colonna B , C, D,E ,F,G i numeri ( esempio 15-3 o 3-15 ecc ) indipendentemente dalla posizione del foglio DATI.

Nella colonna H il numero totale delle ripetizione dei numeri ( ossia se i numeri 15-3 o 3-15) vengono ripetuti per 100 volte mi devo trovare i numeri 15-3 nelle colonne B, C in questo caso come esempio e il numero delle ripetizioni ossia 100  nella colonna H . il numero massimo delle righe è variabile quindi sarebbe ideale avere il numero massimo che excell ha.

Grazie

Massimo

Answer 4

Ciao Massimo,

faccio un esempio:

numeri 2-10-15-30 riga 2

numeri 1-15-30-31 riga 3

numeri 1-12-2-10 riga 4

numeri 4-30-15-25 riga 5

numeri 5-8-11-30 riga 6

il VBA deve cercare in automatico in un range compreso tra i numeri 1 e 30  i numeri che si ripetono nelle righe

riga 2 presente numeri 15 e 30  e si ripetono nella riga 3, riga 5 

riga 2 presneti numeri 2-10 che si ripetono nella riga 4

dopo di che deve copiarli sul foglio 2 indicando i numeri nelle colonne B C D E , e nella F inserire quante volte si sono ripetuti 

Quindi, a patto che io abbia capito, anzichè cercare una singola paio di numeri, il codice deve restituire la ripetuzione di qualunque paio di numeri, sempre rispettando l'ordine dei numeri in ogni paio - cioè 3-15 non viene considerato come una duplicazione della coppia 15-3.

Dato che si tratta di una domanda notevolmente più complessa di quella che avevo inizialmente previsto, prima di intraprendere la creazione di un codice adatto, sarebbe utile se tu potessi spiegare lo scopo e l'utilità del codice richiesto.

===

Regards,

Norman

Answer 5

ciao Norman,

faccio un esempio:

numeri 2-10-15-30 riga 2

numeri 1-15-30-31 riga 3

numeri 1-12-2-10 riga 4

numeri 4-30-15-25 riga 5

numeri 5-8-11-30 riga 6

il VBA deve cercare in automatico in un range compreso tra i numeri 1 e 30  i numeri che si ripetono nelle righe

riga 2 presente numeri 15 e 30  e si ripetono nella riga 3, riga 5 

riga 2 presneti numeri 2-10 che si ripetono nella riga 4

dopo di che deve copiarli sul foglio 2 indicando i numeri nelle colonne B C D E , e nella F inserire quante volte si sono ripetuti 

ecc

Grazie

Massimo