belirli satırların toplamı ve sutunların sayfalara yerleşimi

[qazedctgb]

Merhabalar.

ekte gönderdiğim örnekte
1. olarak sütün 1 ve sütün 2 de aynı satırda olan değerlerin toplamını sutun 3 e ekleme
2. olarak A sayfasındaki sutunları B sayfasına sutun sıraları değişerek eklemek.

Sizlerden ricam hücrelere tek tek toplam formulu girmeden daha kısa bir yolu varmıdır. nedenine gelince; eğer hücrelere tek tek formul girersem 4000 satırdan fazla veri oldugu için dosya boyutu çok artıyor.

Yardımlarınız için şimdiden tşklr.

 

[Huseyinkis]

Merhabalar.

ekte gönderdiğim örnekte
1. olarak sütün 1 ve sütün 2 de aynı satırda olan değerlerin toplamını sutun 3 e ekleme
2. olarak A sayfasındaki sutunları B sayfasına sutun sıraları değişerek eklemek.

Sizlerden ricam hücrelere tek tek toplam formulu girmeden daha kısa bir yolu varmıdır. nedenine gelince; eğer hücrelere tek tek formul girersem 4000 satırdan fazla veri oldugu için dosya boyutu çok artıyor.

Yardımlarınız için şimdiden tşklr.

Ekteki kodları incelermisiniz.

Sub toplamalaktar()
Application.ScreenUpdating = False
Set s1 = Sheets("A")
Set s2 = Sheets("B")
s1.Select
For i = 1 To s1.Range("A65536").End(3).Row
If IsNumeric(s1.Cells(i, 1).Value) Then
s1.Cells(i, 3).Value = s1.Cells(i, 2).Value + s1.Cells(i, 1).Value
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(i, 3).Value = s1.Cells(i, 1).Value
s2.Cells(i, 2).Value = s1.Cells(i, 3).Value
s2.Cells(i, 1).Value = s1.Cells(i, 2).Value
End If
Next
s1.Select
Application.ScreenUpdating = True
End Sub

 

[qazedctgb]

öncelikle bu kadar kısa sürede cevap verdiğiniz için tşklr.

elinize sağlık. verdiğiniz kodu 'Sub auto_open() ile çalıştırdığımda sayfayı kaydedip tekrar açınca çalışıyor yalnız veri eklemeyi eş zamanlı yapma şansımız olabilir mi.
tşklr

 

[Huseyinkis]

öncelikle bu kadar kısa sürede cevap verdiğiniz için tşklr.

elinize sağlık. verdiğiniz kodu 'Sub auto_open() ile çalıştırdığımda sayfayı kaydedip tekrar açınca çalışıyor yalnız veri eklemeyi eş zamanlı yapma şansımız olabilir mi.
tşklr

Dosyayı her açılışta B sayfasına en alta doğru ekleme yapar buda kayıtların 1 den fazla olmasına sebep olur..

siz a sayfası 1 ve 2 sutuna veri girdiğinizde otomatik b sayfasına aktarmasını ve toplamını almasını sağlayabiliriz.

 

[qazedctgb]

size zahmet kastettiğinizi nasıl yapabiliriz yardımcı olur musunuz.

 

[Huseyinkis]

size zahmet kastettiğinizi nasıl yapabiliriz yardımcı olur musunuz.

Ekteki kodları sayfa1 kod kısmına yapıştırınız. Autpen iptal ediniz. a sayfası b sutununda değişiklik yapıldığı anda toplamı alır ve b sayfasına aktarı. ve a sayfası d sutununa işlendi yazar.

eğer a sayfası d sutununa işlendi yazmasını istemiyorsanız işlemi renk vererekte yapabiliriz.
işlendi aynı kaydı b sayfasına tekrar atmamamsı için gerekli.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B:B")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set s1 = Sheets("A")
Set s2 = Sheets("B")
s1.Select
For i = 1 To s1.Range("A65536").End(3).Row
If IsNumeric(s1.Cells(i, 1).Value) And s1.Cells(i, 4).Value = "" Then
s1.Cells(i, 3).Value = s1.Cells(i, 2).Value + s1.Cells(i, 1).Value
s1.Cells(i, 4).Value = "işlendi"
s2.Select
sonsat = s2.Range("A65536").End(3).Row + 1
s2.Cells(i, 3).Value = s1.Cells(i, 1).Value
s2.Cells(i, 2).Value = s1.Cells(i, 3).Value
s2.Cells(i, 1).Value = s1.Cells(i, 2).Value
End If
Next
s1.Select
Application.ScreenUpdating = True
End Sub

 

[qazedctgb]

bilmeyince herşey zor. yardımlarınız için içten çok teşekkür ederim.

İyi çalışmalar...