Macro ricerca valori successivi

Hai un problema con Excel?

Nuova discussione

Macro ricerca valori successivi
di bobo (utente non iscritto) data: 03/06/2015 14:30:22
Buongiorno a tutti,
nel tentativo di scrivere una macro per ordinare e modificare delle matrici di dati, mi sono bloccato nella ricerca del valore successivo alle caselle vuote.
Espongo il problema con un esempio,indicando 2 colonne soltanto:
1 2
1
2 3

4
3 6

8
7

9

8 5
Devo ricopiare le colonne e coprire i "buchi" con il valore medio tra il dato precedente e quello successivo alle caselle vuote,che non si presentano con continuità,mentre i dati esistenti vanno semplicemente ricopiati,quindi:
1 2
1 2.5
2 3
3 4.5
4 4.5
3 6
5 7
5 8
7 8.5
7.5 8.5
7.5 9
7.5 7
8 5
Grazie mille...
di Luca73 data: 03/06/2015 15:02:14
Ciao
mi confermi che se hai più buchi inserisci sempre lo stesso valore?
la matrice va copiata o solo completata?
la matrice inizia e finisce con una riga piena?
la matrice ha lunghezza fissa o variabile?
Inserisci un file di esempio perchè nella formattazione si perdono delle informazioni.
Hai detto che stavi già scrivendo una macro. allegala così chi ti aiuta non parte da 0 ma dalla tua base.
Ciao
Luca
di bobo (utente non iscritto) data: 03/06/2015 15:04:29
Ragazzi noto ora che pubblicando la domanda alcuni valori sono stati cancellati,quindi riscrivo considerando una sola colonna:
1
1

2

4

3
2

1
Il risultato deve essere:
1
1
1.5
2
3
3
4
3.5
3.5
3.5
3
2
1.5
1
Il problema si ripropone su più colonne.
Scusate per il disguido di prima
di bobo (utente non iscritto) data: 03/06/2015 15:17:52
Ciao Luca!
Dunque, sì, se ho più buchi inserisco sempre lo stesso valore.
La matrice iniziale ha questi buchi,io ne vorrei creare una completa in un nuovo foglio,lasciando invariata quella iniziale.
La matrice ha una lunghezza fissa ma ogni colonna arbitrariamente può iniziare o finire con dei buchi.
La macro a cui ho cominciato a lavorare si basa su due vettori prova molto corti e non funzionando l'ho cancellata. La matrice sulla quale andrò a lavorare ha circa 26 mila righe e 60 colonne, e contiene dati che non posso divulgare.
Ti ringrazio per l'attenzione....
di bobo (utente non iscritto) data: 03/06/2015 15:29:09
Ho caricato un file esempio.
Grazie,dimmi come posso esserti di maggior aiuto Luca...

di Mister_x (utente non iscritto) data: 03/06/2015 16:57:40
ciao

Sub() da provare

allego file con due prove Foglio1 e foglio2
foglio1 riporto dati su altra colonna foglio2 su se stessa

ciao

Option Explicit
Sub Ric_valori()
Dim Col_i As Variant, Col_o As Variant
Dim i As Long, r As Long
Dim Val1 As Long, Val2 As Long
Col_i = InputBox("Colonna di Lettura")
Col_o = InputBox("colonna Destinazione dati")  'Puo' essere la stessa di Lettura
For i = 2 To Cells(Rows.Count, Col_i).End(xlUp).Row
  If Cells(i, Col_i) <> "" Then
  Val1 = Cells(i, Col_i)
  Cells(i, Col_o) = Val1
  Else
    For r = i To Cells(Rows.Count, Col_i).End(xlUp).Row
      If Cells(r, Col_i) <> "" Then
       Val2 = Cells(r, Col_i)
       Cells(i, Col_o) = (Val1 + Val2) / 2
       Exit For
      End If
    Next r
  End If
Next i
If Cells(i, Col_i) = "" Then Cells(i, Col_o) = Val1
End Sub

di Luca73 data: 03/06/2015 17:53:18
Ciao Mi ero messo anche io a svilupparlo poi il lavoro ha preso il sopravvento.
Non è bella e succinta come quella Mister_x ma mi sembra funzionare
Per ora l'ho fatta per copiare in G2

Ciao
Luca

Sub CopiaECompleta()
Dim RangeLavoro As Range
Dim CellaLavoro As Range
Dim RigheLavoro
Dim ColonneLavoro
Dim ColonnaInd
Dim RigaInd
Dim MiaMatrice()
Set RangeLavoro = Application.InputBox("Selezionare range di Lavoro escluso l'intesatazione", "SELEZIONE", , , , , , 8)

Columns("G:H").Select
Selection.Delete Shift:=xlToLeft
Range("G1:H1").Merge
Range("G1:H1").FormulaR1C1 = "Matrice risultato"
RangeLavoro.Copy
Range("G2").Select
ActiveSheet.Paste
RigheLavoro = RangeLavoro.Rows.Count
ColonneLavoro = RangeLavoro.Columns.Count
ReDim MiaMatrice(1 To RigheLavoro, 1 To ColonneLavoro)
For ColonnaInd = 1 To ColonneLavoro
    For RigaInd = 1 To RigheLavoro
    Range("G1").Offset(0, 0).Select
        If Range("G2").Offset(RigaInd - 1, ColonnaInd - 1) <> "" Then
            MiaMatrice(RigaInd, ColonnaInd) = Range("G2").Offset(RigaInd - 1, ColonnaInd - 1)
        Else
            If (Range("G2").Offset(RigaInd - 1, ColonnaInd - 1).End(xlUp).Row < 2) Then
                MiaMatrice(RigaInd, ColonnaInd) = Range("G2").Offset(RigaInd - 1, ColonnaInd - 1).End(xlDown)
            ElseIf (Range("G2").Offset(RigaInd - 1, ColonnaInd - 1).End(xlDown).Row > (RigheLavoro + 1)) Then
                MiaMatrice(RigaInd, ColonnaInd) = Range("G2").Offset(RigaInd - 1, ColonnaInd - 1).End(xlUp)
            Else
                MiaMatrice(RigaInd, ColonnaInd) = Range("G2").Offset(RigaInd - 1, ColonnaInd - 1).End(xlDown) / 2 + Range("G2").Offset(RigaInd - 1, ColonnaInd - 1).End(xlUp) / 2
            End If
        End If
    Next
Next
For ColonnaInd = 1 To ColonneLavoro
    For RigaInd = 1 To RigheLavoro
        Range("G2").Offset(RigaInd - 1, ColonnaInd - 1) = MiaMatrice(RigaInd, ColonnaInd)
    Next
Next


End Sub

di bobo (utente non iscritto) data: 04/06/2015 00:05:58
Ragazzi ho provato le macro,siete geniali!!!!
La macro di Luca,sebbene più sofisticata da capire per un neofita come me,restituisce esattamente i risultati attesi.
La macro di Mister_x del "foglio 1" va altrettanto bene,se posso fare un appunto sulla macro del "foglio 2"(esamina colonna e sulla stessa riporta i risultati) restituisce un valore in più sulla prima colonna (in questo caso un 1).
Però che dire ragazzi,grazie mille davvero,avete risolto un bel problema che mi impediva di andare avanti con la tesi!

di Mister_x (utente non iscritto) data: 04/06/2015 09:12:46
ciao bobo

visto adesso il tuo intervento, quindi per il proplema del numero in piu' possiamo utilizzare un flag di controllo e rilevare il numero di riga maggiore di tutti
posto la sub() con modifica, allego il file con modifiche

ciao

Option Explicit
Sub Ric_valori()
Dim Col_i As Variant, Col_o As Variant
Dim i As Long, r As Long, Nriga As Long
Dim Val1 As Long, Val2 As Long
Dim flag As Long
Col_i = InputBox("Colonna di Lettura")
Col_o = InputBox("colonna Destinazione dati") 'Puo' essere la stessa di Lettura
Nriga = UsedRange.Row + UsedRange.Rows.Count - 1
For i = 2 To Nriga
flag = 1
  If Cells(i, Col_i) <> "" Then
  Val1 = Cells(i, Col_i)
  Cells(i, Col_o) = Val1
  flag = 0
  Else
    For r = i To Nriga
      If Cells(r, Col_i) <> "" Then
       Val2 = Cells(r, Col_i)
       Cells(i, Col_o) = (Val1 + Val2) / 2
       Exit For
      End If
    Next r
  End If
Next i
If flag = 1 Then Cells(i - 1, Col_o) = Val1
End Sub

di bobo (utente non iscritto) data: 04/06/2015 19:42:18
Ciao Mister_x

Ora la macro funziona correttamente!
Un'ultima domanda,siccome le colonne da elaborare sono 20,in particolare "range(C4:BL4)",è possibile automatizzare il calcolo sul range completo anzichè indicare volta per volta la colonna?
La destinazione dati va bene anche la stessa di lettura.
Ti ringrazio molto...
di Mister_x (utente non iscritto) data: 04/06/2015 22:22:31
ciao

la cosa e' fattibilissima, il proprema a priori sta ne range che tu hai indicato da C4:BL4,
in questo range non ci sono 20 colonne ma bensi 62 quindi si presuppone che tu abbia colonne non contigue ma falsate dove fra l'una e l'altra tu hai colonne con inserite altri valori o descrizioni

quindi a questo punto posta un file con la struttura reale del foglio per capire il procedimento oppure tratta la sub(9 con un bottone per attivarla

ciao
di bobo (utente non iscritto) data: 04/06/2015 22:46:59
Scusa errore mio di svista,sto perdendo la concentrazione con questi dati...
Come ti dicevo il range è proprio (C4:BL4) e contiene dati in tutte le colonne,che come dici giustamente tu sono 62! Ho sbagliato a dirti 20 perchè in realtà 20 sono le celle del range con valori diversi dal "valore vuoto",ma non è un problema per la tua macro!
La matrice totale è enorme ed è la seguente:(C4:BL25935)
Con un paio di modifiche sono riuscito a utilizzare la macro di Luca_73, ma ero interessato a vedere anche come gira la tua visto che hai utilizzato istruzioni diverse...
Grazie mille per l'aiuto...

di Mister_x (utente non iscritto) data: 05/06/2015 00:09:25
ciao

con i dati che hai postato sostanzialmente la sub() non differisce di molto, tranne una aggiunta di un ciclo for per le colonne e la variazione di variabile alle colonne dati presa dal ciclo for co
per il resto come vedi e' tutto ugale solamente la riga di partenza e' passata da 2 a 4

ciao

riposto il file dove in foglio3 ho fatto al prova

Option Explicit
Sub Ric_valori3()
Dim Col_i As Variant, Col_o As Variant
Dim i As Long, r As Long, Nriga As Long, co As Long
Dim Val1 As Long, Val2 As Long
Dim flag As Long
On Error Resume Next
For co = 3 To 64  '' colonne
Col_i = co
Col_o = co  'Puo' essere la stessa di Lettura
Nriga = UsedRange.Row + UsedRange.Rows.Count - 1
 ''Nriga = InputBox("Inserire Ultimo Numero di Riga")
For i = 4 To Nriga
flag = 1
  If Cells(i, Col_i) <> "" Then
  Val1 = Cells(i, Col_i)
  Cells(i, Col_o) = Val1
  flag = 0
  Else
    For r = i To Nriga
      If Cells(r, Col_i) <> "" Then
       Val2 = Cells(r, Col_i)
       Cells(i, Col_o) = (Val1 + Val2) / 2
       Exit For
      End If
    Next r
  End If
Next i
If flag = 1 Then Cells(i - 1, Col_o) = Val1
Next co
End Sub

di bobo (utente non iscritto) data: 05/06/2015 00:34:59
L'ho provata,credo tu abbia dimenticato di inserire "dim UsedRange as range".
Nonostante questa correzione(spero giusta) la macro non parte...
Ti allego file di prova su cui provare a farla girare...

di Mister_x (utente non iscritto) data: 05/06/2015 08:47:30
ciao bobo

il problema sta solamente nelle variabili Val1,Val2 dichiarate long in quanto tu parlavi di valori 1,2,3 ecc mentre tu nel tuo file hai valori superiori alla variabile long, quindi adesso ho messo queste q Double e come vedrai dal tuo file tutto e' risolto

PS perche hai dichiarato dim UsedRange as range". ????
io non seleziono niente per un set range() .

comunque ti riallego il tuo file con la sub inserita
PS. Attenzione che alle volte la sub() va esequita 2 volte

ciao

Option Explicit
Sub Ric_valori3()
Dim Col_i As Variant, Col_o As Variant
Dim i As Long, r As Long, Nriga As Long, co As Long
Dim Val1 As Double, Val2 As Double
Dim flag As Long
On Error Resume Next
For co = 3 To 64  '' colonne
Col_i = co
Col_o = co  'Puo' essere la stessa di Lettura
Nriga = UsedRange.Row + UsedRange.Rows.Count - 1
 ''Nriga = InputBox("Inserire Ultimo Numero di Riga")
For i = 4 To Nriga
flag = 1
  If Cells(i, Col_i) <> "" Then
  Val1 = Cells(i, Col_i)
  Cells(i, Col_o) = Val1
  flag = 0
  Else
    For r = i To Nriga
      If Cells(r, Col_i) <> "" Then
       Val2 = Cells(r, Col_i)
       Cells(i, Col_o) = (Val1 + Val2) / 2
       Exit For
      End If
    Next r
  End If
Next i
If flag = 1 Then Cells(i - 1, Col_o) = Val1
Next co
End Sub

di bobo (utente non iscritto) data: 05/06/2015 09:58:02
Ciao Mister_x
Dunque, ho provato la macro.
Nel foglio che mi hai allegato funziona correttamente,ma quando uso la macro nel mio foglio con la matrice originale mi dice che non ho dichiarato la variabile "UsedRange", per questo mi ero permesso di segnalartelo...
Tuttavia,anche dichiarandola,la macro và in esecuzione ma non fa nulla,neanche facendola partire più volte.
E' un bel mistero....

di Mister_x (utente non iscritto) data: 05/06/2015 12:46:04
ciao

UsedRange e' una proprieta' di sola lettura di excel, da help
Worksheet.UsedRange, proprietà
Restituisce un oggetto Range che rappresenta l'intervallo utilizzato del foglio di lavoro specificato. Proprietà di sola lettura.

quindi non e' una variabile , ma un oggetto

comunque prova a sostituire la sub() con questa che ti posto, la quale ti chiede fino a che riga vuoi elaborare i tuoi dati
nel tuo caso devi inserire un valore di 25935

ciao

Option Explicit
Sub Ric_valori3()
Dim Col_i As Variant, Col_o As Variant
Dim i As Long, r As Long, Nriga As Long, co As Long
Dim Val1 As Double, Val2 As Double
Dim flag As Long
On Error Resume Next
Nriga = InputBox("Inserire Ultimo Numero di Riga") ''
For co = 3 To 64  '' colonne
Col_i = co
Col_o = co  'Puo' essere la stessa di Lettura
''Nriga = UsedRange.Row + UsedRange.Rows.Count - 1
 For i = 4 To Nriga
flag = 1
  If Cells(i, Col_i) <> "" Then
  Val1 = Cells(i, Col_i)
  Cells(i, Col_o) = Val1
  flag = 0
  Else
    For r = i To Nriga
      If Cells(r, Col_i) <> "" Then
       Val2 = Cells(r, Col_i)
       Cells(i, Col_o) = (Val1 + Val2) / 2
       Exit For
      End If
    Next r
  End If
Next i
If flag = 1 Then Cells(i - 1, Col_o) = Val1
Next co
End Sub

di bobo (utente non iscritto) data: 05/06/2015 14:38:48
ok ora funziona!!!
Grazie mille Mister_x per il tempo dedicatomi.
Un ringraziamento anche a Luca73.
In caso di futuri dubbi saprò a chi rivolgermi

Vuoi Approfondire?