Macro malfunzionante

[libraio]

Ciao a tutti,
ho ripreso con Excel 2003 una macro che utilizzavo con Excel 97, ma i risultati sono inesatti.
Io non saprei da che parte iniziare... Qualcuno può cortesemente controllarla e correggermi il codice?
Ogni eventuale miglioramento è "molto appressato"!
Allego cartella di lavoro qui:
http://rapidshare.com/files/358409008/C ... i.xls.html
Grazie
libraio

[Anthony47]

Ci dai un aiutino, ad esempio che cosa dovrebbe fare la macro?

Ciao

[libraio]

Come descritto in riga 1:
colonne I-J-H i dati presenti sia in A-B-C, sia in D-E-F
colonne L-M-N i dati presenti sia in D-E-F, sia in A-B-C
(è forse un eccesso di verifica incrociata...)
colonne O-P-Q dati presenti in A-B-C, ma non in D-E-F
Colonne R-S-T dati presenti in D-E-F, ma non in A-B-C

Le colonne di riferimento per il confronto sono A e C

Spero di essere stato chiaro e ti ringrazio per la "solita" insostituibile disponibilità
libraio

[Anthony47]

La macro puo' essere velocizzata usando la WorksheetFunction.Countif (che esisteva gia' in excel 97), con completamento in 2-3 secondi, rispetto alla quaresima che richiede quella attuale.
Allo scopo sostituire questa parte

Codice: Seleziona tutto

  For Each cc1 In rng1
         manca = True
         For Each cc2 In rng2
            If cc1.Value = cc2.Value Then
               manca = False
               cc1.Offset(, 8).Resize(, 3).Value = cc1.Resize(, 3).Value
               Exit For
            End If
         Next
         If manca Then cc1.Offset(, 14).Resize(, 3).Value _
            = cc1.Resize(, 3).Value
      Next

con questa:

Codice: Seleziona tutto

For Each cc1 In rng1
If Application.WorksheetFunction.CountIf(rng2, cc1.Value) > 0 Then
               cc1.Offset(, 8).Resize(, 3).Value = cc1.Resize(, 3).Value
Else
cc1.Offset(, 14).Resize(, 3).Value = cc1.Resize(, 3).Value
End If
Next


Noterai il rozzo allineamento verticale delle istruzioni, rispetto alla sinuosa indentazione della versione precedente; ma e' leggermente piu' veloce.

A parte la velocita', la macro precedente non considera uguali stringhe minuscolo e stringhe maiuscole, quindi ad esempio ABITARE SEGESTA e Abitare Segesta sono considerati diversi. Per evitare cio' potresti sostituire If cc1.Value = cc2.Value Then con If UCase(cc1.Value) = UCase(cc2.Value) Then

Ciao.

[libraio]

Grazie Anthony,
ho corretto il codice ed ora è "un turbo".

Giustamente tu aggiungi:

A parte la velocita', la macro precedente non considera uguali stringhe minuscolo e stringhe maiuscole, quindi ad esempio ABITARE SEGESTA e Abitare Segesta sono considerati diversi. Per evitare cio' potresti sostituire If cc1.Value = cc2.Value Then con If UCase(cc1.Value) =UCase(cc2.Value) Then

ma io non trovo la stringa da modificare... unisco il codice corretto:

Codice: Seleziona tutto

Sub seleziona()
   Dim rng1 As Range, rng2 As Range
   Dim cc1 As Range, cc2 As Range
   Dim manca As Boolean, alt As Long
   Application.Calculation = xlManual
   Application.ScreenUpdating = False
   Set rng1 = Worksheets("Foglio1").Range("A2")
   With rng1.Offset(-1, 8).Resize(, 3)
        .HorizontalAlignment = xlCenter
        .MergeCells = True
        .Value = "In A e anche in D"
   End With
   With rng1.Offset(-1, 14).Resize(, 3)
        .HorizontalAlignment = xlCenter
        .MergeCells = True
        .Value = "In A ma non in D"
   End With
   Set rng1 = rng1.Resize(rng1.End(xlDown).Row - rng1.Row + 1)
   Set rng2 = Worksheets("Foglio1").Range("D2")
   With rng2.Offset(-1, 8).Resize(, 3)
        .HorizontalAlignment = xlCenter
        .MergeCells = True
        .Value = "In D e anche in A"
   End With
   With rng2.Offset(-1, 14).Resize(, 3)
        .HorizontalAlignment = xlCenter
        .MergeCells = True
        .Value = "In D ma non in A"
   End With
   Set rng2 = rng2.Resize(rng2.End(xlDown).Row - rng2.Row + 1)
   For alt = 0 To 1
      If alt Then
         Set cc1 = rng1
         Set rng1 = rng2
         Set rng2 = cc1
      End If
For Each cc1 In rng1
If Application.WorksheetFunction.CountIf(rng2, cc1.Value) > 0 Then
               cc1.Offset(, 8).Resize(, 3).Value = cc1.Resize(, 3).Value
Else
cc1.Offset(, 14).Resize(, 3).Value = cc1.Resize(, 3).Value
End If
Next
   Next
   rng1.Offset(, 8).Resize(, 3).Sort _
      Key1:=rng1.Offset(, 8).Resize(1, 1), _
      Order1:=xlAscending, _
      Header:=xlNo, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom
   rng1.Offset(, 14).Resize(, 3).Sort _
      Key1:=rng1.Offset(, 14).Resize(1, 1), _
      Order1:=xlAscending, _
      Header:=xlNo, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom
   rng2.Offset(, 8).Resize(, 3).Sort _
      Key1:=rng2.Offset(, 8).Resize(1, 1), _
      Order1:=xlAscending, _
      Header:=xlNo, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom
   rng2.Offset(, 14).Resize(, 3).Sort _
      Key1:=rng2.Offset(, 14).Resize(1, 1), _
      Order1:=xlAscending, _
      Header:=xlNo, _
      MatchCase:=False, _
      Orientation:=xlTopToBottom
   Application.Calculation = xlAutomatic
   Application.ScreenUpdating = True
End Sub

...dov'è?... :oops:
Ciao e grazie

[Anthony47]

A parte la velocita', la macro precedente non considera uguali stringhe minuscolo e stringhe maiuscole, quindi ad esempio ABITARE SEGESTA e Abitare Segesta sono considerati diversi.

Questo commento era riferito alla macro tua originale, e l' ho inserito per dare una giustificazione alle anomalie sui risultati di cui tu parlavi.
Quindi la modifica (sostituire If cc1.Value = cc2.Value Then con If UCase(cc1.Value) = UCase(cc2.Value) Then) riguarderebbe il vecchio codice. Ma se la nuova macro fa quello che cerchi allora immagino che non vorrai tornare alla vecchia.

Ciao.

[libraio]

ben detto, ancora grazie
libraio