iki sayfa arasında fark bulmak

[rauben]

merhaba ekteki dosyada sayfa 1 de b sütununda yer alan kodlar 1000 tane ve farklı. aynı şekilde 2. sayfadada aynı kodlardan mevcut. benim istediğim 2. sayfadaki kodların karşılığı olan ve f sütununda yer alan miktarlardan sayfa 1 deki aynı koda ait miktarı çıkaracak ve sayfa 3ün b sütununa kodu ve c sütununa o koda karşılık gelen seri numarasını ve f sütununa da farkı yazdırmak. bu konuda yardımlarınızı rica ederim.

 

[veyselemre]

[vb:1:66834f0379]Sub dene()

Set sm = Sheets("mart")
Set sn = Sheets("nisan")
Set sf = Sheets("fark")
sf.Cells.ClearContents
sf.Range("B1:F1") = sm.Range("B1:F1").Value
sat = 2
For x = 2 To sm.[b65536].End(3).Row
sf.Cells(sat, 2) = sm.Cells(x, 2)
sf.Cells(sat, 3) = sm.Cells(x, 3)
sf.Cells(sat, 6) = sm.Cells(x, 6)
sat = sat + 1
Next x
For x = 2 To sn.[b65536].End(3).Row
sf.Cells(sat, 2) = sn.Cells(x, 2)
sf.Cells(sat, 3) = sn.Cells(x, 3)
sf.Cells(sat, 6) = -1 * sn.Cells(x, 6)
sat = sat + 1
Next x
sf.Select
For x = 2 To [b65536].End(3).Row - 1
For xx = x + 1 To [b65536].End(3).Row + 1
If Cells(x, 2) = Cells(xx, 2) Then
Cells(x, 6) = Cells(x, 6) + Cells(xx, 6)
Range(Cells(xx, 2), Cells(xx, 6)).ClearContents
End If
Next xx
Next x
Range(Cells(2, 2), Cells([b65536].End(3).Row, 2)).Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
End Sub[/vb:1:66834f0379]

 

[rauben]

güzel çalışma ellerine sağlık arkadaşım ama asıl istediğim nisan sayfasında ki kodeları ve o kode karşılık gelen tutarı mart sayfasında bulacak bunların farkını alacak aynı zamanda nisan sayfasında olupta mart sayfasında olmayan kodu renkli bir şekilde belirtecek bir yöntem. sonucu fark bölmesine yazarken sütun başlıklarına göre diğer değerleride fark bölmesinde yazdırabilmeyi istiyorum. ekteki dosyada fark bölümünde ne görmek stediğimi açıkladım. şimdiden yardımlarınız için teşekkür ederim.

 

[veyselemre]

[vb:1:499574586f]Sub dene()
Set sm = Sheets("mart")
Set sn = Sheets("nisan")
Set sf = Sheets("fark")
On Error Resume Next
sf.Cells.ClearContents ""
sf.Cells.Font.Bold = False

sf.Range("A1:F1") = sn.Range("A1:F1").Value
For x = 2 To sn.[b65536].End(3).Row
For y = 1 To 6
sf.Cells(x, y) = sn.Cells(x, y)
Next y
sat = 0
sat = sm.Columns("b").Find(sf.Cells(x, 2)).Row

If sat = 0 Then
sf.Range(Cells(x, 1), Cells(x, 6)).Font.Bold = True
GoTo atla
End If

sf.Cells(x, 6) = sf.Cells(x, 6) - sm.Cells(sat, 6)
atla:
Next x
End Sub[/vb:1:499574586f]

 

[rauben]

teşekkür ederim bu tam istediğim gibi oldu

 

[mahmut arslan]

slmlar

 

[even]

ben de kendime uyarlamaya çalışacagım inşallah olur