Aggiungere intervalli macro

Hai un problema con Excel?

Nuova discussione

Aggiungere intervalli macro
di Valerio (utente non iscritto) data: 27/09/2013 07:24:34
Buondì. Ho questo codice che funziona bene però oltre all'intervalle P5:S8 devo aggiungere altri 2 e cioè C30:G31 e H20:L21, come lo devo modicare? Praticamente questa macro mi trova i numeri uguali che ci sono nell'intervallo P5:S8 e C5:L13 e in quest'ultimo gli elimina. Grazie

Sub Elimina()
    Dim sh As Worksheet, col As Integer, riga As Long, col1 As Integer, riga1 As Long
    
    Set sh = Sheets("Foglio1")
      For col = 16 To 19
       For riga = 5 To 8
         For col1 = 3 To 12
           For riga1 = 5 To 13
             If Cells(riga, col) = Cells(riga1, col1) Then Cells(riga1, col1) = ""
           Next riga1
         Next col1
       Next riga
      Next col    
        
   Set sh = Nothing

End Sub

di totygno71 (utente non iscritto) data: 27/09/2013 08:34:08
ciao

se P5:s8 = riga 5 to 8 -- col 16 to 19...

C30:G31 equivale a...
stessa cosa per h20:h21
provaci ciao
di Valerio (utente non iscritto) data: 27/09/2013 09:26:11
Grazie di avermi risposto? Ma dove lo devo scrivere quel codice, prima di End sub? Com'è precisamente siccome non è che abbia capito bene.
di totygno71 (utente non iscritto) data: 27/09/2013 09:38:14
Una soluzione indolore potrebbe essere duplicare lo stesso ciclo per i nuovi range, sostituendo al p5:s8 prima C30:G31 e poi H20:L21

di totygno71 (utente non iscritto) data: 27/09/2013 09:41:59
Questo per il range C30:G31...
poi fai la stessa cosa per H20:L21

Sub Elimina()
    Dim sh As Worksheet, col As Integer, riga As Long, col1 As Integer, riga1 As Long
    
    Set sh = Sheets("Foglio1")
      For col = 16 To 19
       For riga = 5 To 8
         For col1 = 3 To 12
           For riga1 = 5 To 13
             If Cells(riga, col) = Cells(riga1, col1) Then Cells(riga1, col1) = ""
           Next riga1
         Next col1
       Next riga
      Next col    

'secondo range
For col = 3 To 7
       For riga = 30 To 31
         For col1 = 3 To 12
           For riga1 = 5 To 13
             If Cells(riga, col) = Cells(riga1, col1) Then Cells(riga1, col1) = ""
           Next riga1
         Next col1
       Next riga
      Next col    
'qui metti il terzo ^_^
        
   Set sh = Nothing

End Sub

di Valerio (utente non iscritto) data: 27/09/2013 11:18:49
Così l'avevo pensata pure io però la macro va lenta, se ci sono soluzioni migliori è bene altrimenti mi tocca usarla.
di totygno71 (utente non iscritto) data: 27/09/2013 18:21:33
La tua richiesta era come modificare quella che già avevi e non pensare una nuova modalità---
Poi che sia lenta mi sembra proprio strano...
di totygno71 (utente non iscritto) data: 27/09/2013 18:29:12
cit:Grazie di avermi risposto? Ma dove lo devo scrivere quel codice, prima di End sub? Com'è precisamente siccome non è che abbia capito bene.
cit2"Così l'avevo pensata pure io però

risp" permettimi ma dubito della cit2 ^_^
di Valerio (utente non iscritto) data: 27/09/2013 19:11:33
Io già avevo provato in questo modo ma mi sembrava una soluzione "fatta a casa", è funzionante però mi andava lenta; praticamente sullo stesso foglio ho la macro per un solo intervallo cioè P5:S8 e poi l'altra per tutti e 3 gli intervalli che però mi va un pò lenta. Perciò ho pensato che fare 3 volte la stessa operazione era una cosa sbagliata ed ho chiesto a voi esperti. Tutto qua.
cit: se P5:s8 = riga 5 to 8 -- col 16 to 19...
C30:G31 equivale a...
stessa cosa per h20:h21
Vedendo questo codice avevo pensato che tu volessi modificare la macro inserendo tre If.
di totygno71 (utente non iscritto) data: 27/09/2013 19:59:57
Quella di fare 3 cicli è una mia ipostesi perche tu volevi implementare quella che già avevi... magari qualcuno conoscendo piu a fondo la tua questione ti può trovare una soluzione alternativa...
PS per curiosità quanto ci impiega a fare i tre cicli?

di gaetanopr data: 28/09/2013 00:22:24
Ciao prova questa macro

Sub Elimina2()
   Set sh = Sheets("Foglio1")
   Set r1 = Range("P5:S8")
   Set r2 = Range("C30:G31")
   Set r3 = Range("H20:L21")

   Set myMultiAreaRange = Union(r1, r2, r3)
    For col1 = 3 To 12
     For riga1 = 5 To 13
       For Each CL In myMultiAreaRange
        If CL = Cells(riga1, col1).Value Then Cells(riga1, col1).Value = ""
       Next CL
     Next riga1
    Next col1
     
   Set sh = Nothing
   Set r1 = Nothing
   Set r2 = Nothing
   Set r3 = Nothing
   Set myMultiAreaRange = Nothing

End Sub

di gaetanopr (utente non iscritto) data: 28/09/2013 08:00:17
Ciao mi sono accorto di aver creato il foglio (sh) ma di non averlo utilizzato, quindi se va bene puoi sistemare tu la macro.
sh.Range ect ect

Stesso discorso nella macro che hai postato all'inizio
di Valerio (utente non iscritto) data: 28/09/2013 09:35:35
@totygno71
Con i tre intervalli mi è successo più di una volta che sembrava come se andasse in conflitto e dopo circa 15 secondi terminava i 3 cicli, una cosa brutta da vedere!
@gaetanopr
grazie per il codice ma io non so proprio come sistemarlo! Il vba e io siamo come il Sole e la Terra: distiamo anni luce uno dall'altro!

di gaetanopr data: 28/09/2013 09:39:45
il codice già funziona, se lavori sul foglio attivo non avresti nemmeno bisogno di indicarlo

Sub Elimina2()
   Set sh = Sheets("Foglio1")
   Set r1 = sh.Range("P5:S8")
   Set r2 = sh.Range("C30:G31")
   Set r3 = sh.Range("H20:L21")

   Set myMultiAreaRange = Union(r1, r2, r3)
    For col1 = 3 To 12
     For riga1 = 5 To 13
       For Each CL In myMultiAreaRange
        If CL = sh.Cells(riga1, col1).Value Then sh.Cells(riga1, col1).Value = ""
       Next CL
     Next riga1
    Next col1
     
   Set sh = Nothing
   Set r1 = Nothing
   Set r2 = Nothing
   Set r3 = Nothing
   Set myMultiAreaRange = Nothing

End Sub

di isy data: 28/09/2013 13:11:03
Ciao

Cit: Con i tre intervalli mi è successo più di una volta che sembrava come se andasse in conflitto e dopo circa 15 secondi terminava i 3 cicli, una cosa brutta da vedere!

gaetanopr Mi sono permesso di modificarlo, per utilizzare al meglio il metodo Union

Sub Ciclo_Union()
  Dim rd                  As Range
  Dim r1                  As Range
  Dim r2                  As Range
  Dim r3                  As Range
  Dim myMultiAreaRange    As Range
  Dim cl                  As Variant
  Dim clx                 As Variant
  Dim r                   As Range
  Set rd = Range("C5:L13")
  Set r1 = Range("P5:S8")
  Set r2 = Range("C30:G31")
  Set r3 = Range("H20:L21")
  Set myMultiAreaRange = Union(r1, r2, r3)
  For Each cl In rd
    For Each clx In myMultiAreaRange
        If cl.Value = clx.Value Then
          If r Is Nothing Then
              Set r = Range(cl.Address)
          Else
              Set r = Union(r, Range(cl.Address))
          End If
        End If
    Next
  Next
  If Not r Is Nothing Then
    r = ""
    'r.ClearContents    'Comando opzione
    Set r = Nothing
  End If
   
  Set rd = Nothing
  Set r1 = Nothing
  Set r2 = Nothing
  Set r3 = Nothing
  Set myMultiAreaRange = Nothing

End Sub

di Valerio (utente non iscritto) data: 28/09/2013 18:18:32
Ok, grazie. La macro di isy è perfetta.

Vuoi Approfondire?