checks the records, reports the different ones

Katılım
25 Mayıs 2007
Mesajlar
165
Excel Vers. ve Dili
türkçe vista işletim sistemi
excel2007
türkçe
hi everyone,

please find attached the excel workbook includes two data series (b2:g36 is the one and I2:n36 is the other aggregation) which should be exactly the same.

Here are my questions with its examples :

1) In case of matching the data in the line of I2:N2 with the any and every data in the range of b2:g36, our macro code we will create should be clear the each data both I2:N2 and the matching data of I2:N2 in the range of b2:g36.


example 1)

data in the line of I2:N2 are as follow;

136 rrr TCELL 302 21.05.2007 2412.38

one and only section matches with that data in the range of b2:g36 is the line of b2:g2;

136 rrr TCELL 302 21.05.2007 2412.38

in accordance with the information above, our macro should clear both I2:N2 and b2:g2 lines..

2) in case of having different values of client, equity code or qty or date of acquisition or cost, on condition that the acc number will be the same, macro code should paint to yellow each different cell

example 2)

data in the line of I31 : N31 are as follow;

735180 so IDAS 200,000.000 15.12.2006 92,477.620

however, 735180 acc number' s data in the line of b26:g26 looks like

735180 so IDAS 20000 15.12.2006 92400

in accordance with that information, macro code should paint both E26 (qty cell) and L31 (qty cell) to yellow at the same time. Additionaly, no data should be cleared by the macro in these lines as well.

ımportant condition :

in case of matching the costs, ten percent differences among the two series should not be decerned as real differance by the macro code..

thanks for your help..
 
Son düzenleme:
Katılım
30 Haziran 2005
Mesajlar
149
Kod:
Sub DeleteAndColor()
Dim lastIN As Long: lastIN = Range("I" & Rows.Count).End(xlUp).Row
Dim lastBG As Long: lastBG = Range("B" & Rows.Count).End(xlUp).Row
Dim found1 As Boolean: found1 = False
Dim found2 As Boolean: found2 = False

Application.ScreenUpdating = False

i = 2
While i <= lastIN
    j = 2
    While j <= lastBG
    
        If Range("I" & i).Value = Range("B" & j).Value And _
            Range("J" & i).Value = Range("C" & j).Value And _
            Range("K" & i).Value = Range("D" & j).Value And _
            Range("L" & i).Value = Range("E" & j).Value And _
            Range("M" & i).Value = Range("F" & j).Value And _
            Range("N" & i).Value = Range("G" & j).Value Then
            
            found1 = True
            found2 = True
            Range("A" & j & ":G" & j).Delete shift:=xlUp
            
            lastBG = lastBG - 1
        Else
            If Range("I" & i).Value = Range("B" & j).Value Then
                If Range("J" & i).Value <> Range("C" & j).Value Then
                    Range("J" & i).Interior.Color = vbYellow
                    Range("C" & j).Interior.Color = vbYellow
                End If
                If Range("K" & i).Value <> Range("D" & j).Value Then
                    Range("K" & i).Interior.Color = vbYellow
                    Range("D" & j).Interior.Color = vbYellow
                End If
                If Range("L" & i).Value <> Range("E" & j).Value Then
                    Range("L" & i).Interior.Color = vbYellow
                    Range("E" & j).Interior.Color = vbYellow
                End If
                If Range("M" & i).Value <> Range("F" & j).Value Then
                    Range("M" & i).Interior.Color = vbYellow
                    Range("F" & j).Interior.Color = vbYellow
                End If
                If Range("N" & i).Value <> Range("G" & j).Value Then
                    Range("N" & i).Interior.Color = vbYellow
                    Range("G" & j).Interior.Color = vbYellow
                End If
            End If
        End If
    If Not found1 Then
        j = j + 1
    Else
        found1 = False
    End If
    Wend
    If found2 Then
        Range("I" & i & ":N" & i).Delete shift:=xlUp
        i = i - 1
        lastIN = lastIN - 1
        found2 = False
    End If
    i = i + 1
Wend
Application.ScreenUpdating = True
End Sub
 
Üst