mükerrer kayıtların silinmesi

[dangerboys35]

Kod sütununda 104,201,202,208 dışındaki kodların silinip

Aynı üründen 1(mükerrer) den fazla var ise(mal numarasına göre) birim,kdv li ve kdv siz sütunları toplayarak tek yazmasını istiyorum.Bunu makro ile nasıl yapabilirim.

Yardımcı olursanız çok sevinirim.
Teşekkürler

 

[Korhan Ayhan]

Selamlar,

İstediğiniz işlem için makro kullanmanıza gerek yok. ÖZET TABLO kullanarak rahatlıkla yapabilirsiniz.

VERİ-ÖZET TABLO VE ÖZET GRAFİK RAPORU menüsünü inceleyin.

 

[dangerboys35]

Bu işlemi özet tablodan yapıyorum zaten fakat ben bir butona bastığımda bu işlemi yapmak istiyorum.Buna benzer yaklaşık 5 adet rapor çıkarıcam.

Teşekkürler...

 

[Husgvarna]

Aşağıdaki kodları deneyin.

Private Sub CommandButton1_Click()
For i = 1 To Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
tekrar:
Set x = Range("n" & i + 1 & ":n65536").Find(Cells(i, 14))
If Not x Is Nothing Then
Cells(i, 16) = Cells(i, 16) + Cells(x.Row, 16)
Cells(i, 19) = Cells(i, 19) + Cells(x.Row, 19)
Cells(i, 20) = Cells(i, 20) + Cells(x.Row, 20)
  Rows(x.Row).Delete
 If i = Cells(65536, 1).End(xlUp).Row Then Exit Sub
 GoTo tekrar
    Else
GoTo son
End If
son:
Application.ScreenUpdating = True
 Next
End Sub

veya

Private Sub CommandButton1_Click()
a = Cells(65536, 1).End(xlUp).Row
For i = 2 To a
Application.ScreenUpdating = False
For c = i + 1 To a
If Cells(i, 14) = Cells(c, 14) Then

Cells(i, 16) = Cells(i, 16) + Cells(c, 16)
Cells(i, 19) = Cells(i, 19) + Cells(c, 19)
Cells(i, 20) = Cells(i, 20) + Cells(c, 20)
Rows(c).Delete
c = c - 1
End If: Next
a = Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
Next

End Sub

 

[dangerboys35]

hocam mükerrer olanları siliyor fakat aynı mal numarasına ait mükerrer olanların Birim,Kdv li ve kdv siz tutarlarının toplamını yazmasını istiyorum


teşekkürler

 

[Husgvarna]

Yukarıdaki kod ve dosya değiştirildi inceleyin.

 

[dangerboys35]

toplama işlemini kod sütunundaki mükerrer verilere göre değilde mal no ya göre yapmasını nasıl sağlarız.

 

[Husgvarna]

Şöyle deneyin.

Private Sub CommandButton1_Click()
a = Cells(65536, 1).End(xlUp).Row
For i = 2 To a
Application.ScreenUpdating = False
For c = i + 1 To a
If Cells(i, 12) = Cells(c, 12) Then
Cells(i, 16) = Cells(i, 16) + Cells(c, 16)
Cells(i, 19) = Cells(i, 19) + Cells(c, 19)
Cells(i, 20) = Cells(i, 20) + Cells(c, 20)
End If
If Cells(i, 14) = Cells(c, 14) Then
Rows(c).Delete
c = c - 1
End If: Next
a = Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
Next

End Sub

 

[dangerboys35]

son bişey daha sormak istiyorum.
kod sütununda 104,201,202,208 kodların dışındaki koda ait ürünleri silmek istiyorum.
bu mümkünmüdür.

Teşekkürler

 

[Husgvarna]

Deneyiniz.

Private Sub CommandButton1_Click()

a = Cells(65536, 1).End(xlUp).Row
For i = 2 To a
Application.ScreenUpdating = False
For c = i + 1 To a
If Cells(c, 14) <> 104 And Cells(c, 14) <> 201 And Cells(c, 14) <> 202 And Cells(c, 14) <> 208 Then
If Cells(i, 12) = Cells(c, 12) Then
Cells(i, 16) = Cells(i, 16) + Cells(c, 16)
Cells(i, 19) = Cells(i, 19) + Cells(c, 19)
Cells(i, 20) = Cells(i, 20) + Cells(c, 20)
End If
If Cells(i, 14) = Cells(c, 14) Then
Rows(c).Delete
c = c - 1
End If
End If: Next
a = Cells(65536, 1).End(xlUp).Row
Application.ScreenUpdating = False
Next

End Sub