iki sütunun karşılaştırılması

Katılım
24 Haziran 2005
Mesajlar
2
Merhaba Arkadaşlar,

Ben iki sütunu karşılatırıp aynı değerde olanları aynı satıra getirmek istiyorum.
Örneğin benim ham verim aşağıdaki gibidir:
A1 B1 C1 D1
KOD MİKTAR E.KOD MİKTAR
001 10 005 20
002 15 002 15
003 10 001 20
004 10 003 12
005 25

bu liste 5000 satıra kadar gitmektedir. Ben bu listeyi aşağıdaki şekle dönüştürmek istiyorum:


A1 B1 C1 D1
KOD MİKTAR E.KOD MİKTAR
001 10 001 20
002 15 002 15
003 10 003 12
004 10
005 25 005 20

acilen yardımlarınız bekliyorum
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Merhaba.
2 sütunuda ayrı ayrı artan veya azalan sıralama yapın.
veriler ayni satıra gelecektir.:cool:
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Merhaba.
Dosya ekte.:cool:
Kod:
Sub sirala()
Dim son1 As Long, son2 As Long, sat As Long, i As Long
Sheets("Sayfa1").Select
Range("G1:I65536").ClearContents
sat = 2
For i = 2 To Cells(65536, "A").End(xlUp).Row
        Cells(sat, "G").Value = Cells(i, "A").Value
        Cells(sat, "H").Value = Cells(i, "B").Value
        Cells(sat, "I").Value = "A"
        sat = sat + 1
Next i
For k = 2 To Cells(65536, "D").End(xlUp).Row
    Cells(sat, "G").Value = Cells(k, "D").Value
    Cells(sat, "H").Value = Cells(k, "E").Value
    Cells(sat, "I").Value = "D"
    sat = sat + 1
Next k
Range("G2:I" & Cells(65536, "G").End(xlUp).Row).Sort Range("G2")
Range("A2:E65536").ClearContents
For i = 2 To Cells(65536, "G").End(xlUp).Row
    son1 = Cells(65536, "A").End(xlUp).Row
    son2 = Cells(65536, "D").End(xlUp).Row
    If son1 > son2 Then
        sat = son1 + 1
        Else
        sat = son2 + 1
    End If
    If Cells(i, "I").Value = "A" Then
        Set k = Range("D1:D" & son2).Find(Cells(i, "G"), , , xlWhole)
        If k Is Nothing Then
            Range("A" & sat & ":B" & sat).Value = Range("G" & i & ":H" & i).Value
            Else
            Range("A" & k.Row & ":B" & k.Row).Value = Range("G" & i & ":H" & i).Value
        End If
        Set k = Nothing
    End If
    If Cells(i, "I").Value = "D" Then
        Set k = Range("A1:A" & son1).Find(Cells(i, "G"), , , xlWhole)
        If k Is Nothing Then
            Range("D" & sat & ":E" & sat).Value = Range("G" & i & ":H" & i).Value
            Else
            Range("D" & k.Row & ":E" & k.Row).Value = Range("G" & i & ":H" & i).Value
        End If
        Set k = Nothing
    End If
Next
Range("G1:I65536").ClearContents
MsgBox "İ Ş L E M   T A M A M L A N D I  ..!!"
End Sub
 
Üst