Como tornar a macro do Excel mais curta?

1

Veja o que meu código faz: Procura por entradas duplicadas na coluna A . Aplica cor a ambas as células quando uma duplicata é encontrada.

O que estou tentando alcançar:

  • Reduzir quantidade de código
  • Faça curto e doce
Sub COLOUR_DOUBLE_ENTRY()

Application.Workbooks(file_name).Worksheets("ms").Activate

last_row = Application.Workbooks(file_name).Worksheets("ms").Range("a65536").End(xlUp).Row

   Application.Workbooks(file_name).Worksheets("ms").Range("A:E").Interior.Pattern = xlNone



For a = 2 To last_row
For b = 1 To last_row

'NAME
 first_item = Application.Workbooks(file_name).Worksheets("ms").Range("b" & a).Value
 secound_item = Application.Workbooks(file_name).Worksheets("ms").Range("b" & b + a).Value

'VALUE
first_item_value = Application.Workbooks(file_name).Worksheets("ms").Range("C" & a).Value
secound_item_value = Application.Workbooks(file_name).Worksheets("ms").Range("C" & b + a).Value


If first_item = secound_item And first_item_value = secound_item_value Then


 Application.Workbooks(file_name).Worksheets("ms").Range("A" & a & ":E" & a).Select

With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 49407
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

 Application.Workbooks(file_name).Worksheets("ms").Range("a" & b + a & ":E" & b + a).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 49407
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

End If


Next b
Next a


End Sub
    
por Ashwith Ullal 18.10.2015 / 07:26

1 resposta

1

Sua técnica compara pares de células repetidamente. Aqui está uma maneira de evitar o loop duplo:

Sub COLOUR_DOUBLE_ENTRY()
   Dim N As Long, wf As WorksheetFunction
   Dim rng As Range, r As Range
   Set wf = Application.WorksheetFunction
   N = Cells(Rows.Count, "A").End(xlUp).Row
   Set rng = Range("A1:A" & N)

   For Each r In rng
      If wf.CountIf(rng, r.Value) > 1 Then
         With r.Interior
             .Pattern = xlSolid
             .PatternColorIndex = xlAutomatic
             .Color = 49407
             .TintAndShade = 0
             .PatternTintAndShade = 0
         End With
      End If
   Next r
End Sub

Claro, isso é apenas uma descrição da técnica. Você pode adaptá-lo para atender às suas necessidades.

    
por 18.10.2015 / 15:09