ricerca1

Hai un problema con Excel?

Nuova discussione

ricerca1
di fausto (utente non iscritto) data: 04/08/2013 18:36:46
Ritornando ad un mio precedente quesito che è stato già risolto, pongo il seguente problema:
Se nel foglio2 dell’esempio che allego dal primo menù a tendina si seleziona PIPPO; dal secondo menù si seleziona P.M. e dal terzo si seleziona Marzo, nella sottostante tabella, invece di così come correttamente riportato ( tutte caselle vuote), dovrebbero comparire i valori del foglio1 più prossimi a sinistra.
Nello specifico: P.M. = 914; A. = 600; C.I. = 1275; R.C. = 652; V. = 1206; V.S. = 800.
In definitiva se le caselle di riferimento del foglio1 sono vuote, si devono inserire i valori delle prime caselle, a sx del riferimento piene.
Grazie per l’interessamento

di isy data: 04/08/2013 21:17:24
Ciao

Se ho interpretato correttamente la richiesta prova a sostituire la seguente:
Private Sub Worksheet_Change(ByVal Target As Range)

Elimina poi questa parte di codice presente in modulo1 non puoi scrivere:

Sub ricerca()
Private Sub Worksheet_Change(ByVal Target As Range)
ecc...

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, Range("A2,N2")) Is Nothing Then
Dim nome As String, codice As String, nip As String
Dim rng1 As Range, c As Range, x As Range, Col As Integer

nome = [A2].Value
codice = [N2].Value

For Each c In Sheets(1).Range("B1:DQ1")

    If c.Value = nome Then
    Set rng1 = Sheets(1).Range(c.Offset(1, 0), c.Offset(1, 12))
    For Each x In rng1
        If x.Value = codice Then
          Col = x.Column
          If x.Offset(1, -1) = 0 Then
            [J7].Value = x.Offset(1, x.Offset(1).End(xlToLeft).Column - Col).Value
          Else
            [J7].Value = x.Offset(1, -1).Value
          End If
          
          If x.Offset(2, -1) = 0 Then
            [J8].Value = x.Offset(2, x.Offset(2).End(xlToLeft).Column - Col).Value
          Else
            [J8].Value = x.Offset(2, -1)
          End If
          
          If x.Offset(3, -1) = 0 Then
            [J9].Value = x.Offset(3, x.Offset(3).End(xlToLeft).Column - Col).Value
          Else
            [J9].Value = x.Offset(3, -1)
          End If
          
          If x.Offset(4, -1) = 0 Then
            [J10].Value = x.Offset(4, x.Offset(4).End(xlToLeft).Column - Col).Value
          Else
            [J10].Value = x.Offset(4, -1)
          End If
          
          If x.Offset(5, -1) = 0 Then
            [J11].Value = x.Offset(5, x.Offset(5).End(xlToLeft).Column - Col).Value
          Else
            [J11].Value = x.Offset(5, -1)
          End If
          
          If x.Offset(6, -1) = 0 Then
            [J12].Value = x.Offset(6, x.Offset(6).End(xlToLeft).Column - Col).Value
          Else
            [J12].Value = x.Offset(6, -1)
          End If
          
          If x.Offset(7, -1) = 0 Then
            [J13].Value = x.Offset(7, x.Offset(7).End(xlToLeft).Column - Col).Value
          Else
            [J13].Value = x.Offset(7, -1)
          End If
        Exit For
        End If
    Next x
End If

Next c
End If

End Sub

di fausto (utente non iscritto) data: 04/08/2013 23:19:50
ho provato ma non funziona, prova con un esempio
di isy data: 04/08/2013 23:38:44
Ciao
Vedi allegato
di fausto (utente non iscritto) data: 05/08/2013 08:56:44
Ora funziona, però se è possibile, bisogna restringere la ricerca. La scelta va effettuata all’interno delle colonne relative al Titolo del foglio1: se nel foglio2 si sceglie TOPOLINO, la ricerca deve essere fra Gennaio e Dicembre della relativa tabella TOPOLINO del foglio1, e così via…..

di isy data: 05/08/2013 13:35:37
Ciao

Ho modificato il codice
Sostituisci il precedente

Private Sub Worksheet_Change(ByVal Target As Range)
  On Error Resume Next
  If Not Intersect(Target, Range("A2,N2")) Is Nothing Then
  Dim nome As String, codice As String, nip As String
  Dim rng1 As Range, c As Range, x As Range, Col As Integer, colSx As Integer, cicloA As Long
  
  nome = [A2].Value
  codice = [N2].Value
  
  Range("J7:K12").ClearContents 'Ora cancello i valori precedenti
  
  For Each c In Sheets(1).Range("B1:DQ1")
    If c.Value = nome Then
      Set rng1 = Sheets(1).Range(c.Offset(1, 0), c.Offset(1, 12))
      For Each x In rng1
          If x.Value = codice Then
            Col = x.Column
            colSx = (((Col - 2)  12) * 12) + 2
            For cicloA = 3 To 8
              For ciclo = Col - 1 To colSx Step -1
                If Not Sheets(1).Cells(cicloA, ciclo) = 0 Then
                  Cells(cicloA + 4, "J") = Sheets(1).Cells(cicloA, ciclo)
                  Exit For
                End If
              Next
            Next
          Exit For
          End If
      Next x
      End If
    Next c
  End If

End Sub

di fausto (utente non iscritto) data: 05/08/2013 15:38:02
risolto! grazie
di fausto (utente non iscritto) data: 05/08/2013 16:27:31
Contrordine: mi sono accorto che i risultati nel foglio2 sono sfalsati di un mese, se ad esempio selezioni il mese di giugno, vengono inseriti i dati relativi al mese di maggio.
di isy data: 05/08/2013 18:47:19
Ciao

Cit: Contrordine: mi sono accorto che i risultati nel foglio2 sono sfalsati di un mese, se ad esempio selezioni il mese di giugno, vengono inseriti i dati relativi al mese di maggio.

Se trova un valore non modifica la colonna dove prelevare i valori

Prova così: sostituisci la seguente riga di codice

For ciclo = Col - 1 To colSx Step -1
con:
For ciclo = Col To colSx Step -1

Vuoi Approfondire?