|
 Essa macro do Aplicativo Microsoff Excel VBA, verifica duplicados digitados na coluna(A) e insere um formatação nos duplicados, na cor vermelho.
Sub Verificando_duplicados()
Dim vLoop As Integer
Dim vTestandoLoop As Integer
Dim vLimparRange As String
Dim vLinhas As Integer
Dim vRange As String
'Valores da coluna(A)
Dim iValorDigitado As String
Dim vTestandoValor As String
'Valores da Coluna(B)
Dim iValorDigitadoB As String
Dim vTesteValorB As String
'testando as primeiras 200 linhas da folha de planilha para valores unicos
vLinhas = 200
vLoop = 2
'limpando os dados
vLimparRange = "A2:B" & vLinhas
Range(vLimparRange).Interior.ColorIndex = xlNone
'checando as primeiras 200 linhas da folha de planilha
While vLoop <= vLinhas
iValorDigitado = "A" & CStr(vLoop)
iValorDigitadoB = "B" & CStr(vLoop)
If Len(Range(iValorDigitado).Value) > 0 Then
'testando valores únicos
vTestandoLoop = 2
While vTestandoLoop <= vLinhas
If vLoop <> vTestandoLoop Then
vTestandoValor = "A" & CStr(vTestandoLoop)
vTesteValorB = "B" & CStr(vTestandoLoop)
'para valores duplicados em determinadas células
If (Range(iValorDigitado).Value = Range(vTestandoValor).Value) And (Range(iValorDigitadoB).Value = Range(vTesteValorB).Value) Then
'Estabelecer a cor de fundo em vermelho(3) para os dados duplicados coluna(A)
Range(iValorDigitado).Interior.ColorIndex = 3
Range(vTestandoValor).Interior.ColorIndex = 3
'determinando a cor de fundo vermelho(3) para os dados duplicados na coluna(B)
Range(iValorDigitadoB).Interior.ColorIndex = 3
Range(vTesteValorB).Interior.ColorIndex = 3
End If
End If
vTestandoLoop = vTestandoLoop + 1
Wend
End If
vLoop = vLoop + 1
Wend
End Sub
'retirando os formatos para realização do teste
Sub tirar_format()
Range("A2:B1288").Select
Selection.Interior.ColorIndex = 2
Range("C1").Select
End Sub
'Esta macro abre a paleta de cores
Sub Abre_Paleta_Cores()
a = Application.Dialogs(xlDialogEditColor).Show(1, 0, 0, 0)
End Sub
Aprenda Aplicativo Microsoff Excel VBA - SaberExcel
|