3 koşula göre başka sayfaya verileri aktarma

[derdalan58]

arkadaşlar firmalara ödenen miktarların toplamı 5000 tl olanlara göre aktarma yapmak istiyorum.ayrıntıları dosyada paylaştım.yardımcı olursanız sevinirim

 

[derdalan58]

ihsan hocam yardımınıza ihtiyacım var yine yenidenn

 

[İhsan Tank]

size tam soru soracaktım
ama benim adımı kullanarak yardım talebinde bulunuyorsunuz sorunuzu mümkün olduğunca siteye genel olarak sorunuz bir daha böyle bir hamle yaptığınızda yanıt vermiyeceğim.

sorum ise
kaç tane fatura olduğunu nereden hesaplıyacağız. ve tutarı nasıl hepsalayacağız

 

[halit3]

Sorunuzu eksik söylüyorsunuz 5000 tl olan veri hiç yok
Eğer aynı Vergi Numarası veya T.C. Kimlik Numarasına ait toplamları 5000 tl nin üstünü aktarmak istiyorsanız bu kodu denermisiniz.

Sub aktar()
deg1 = 5000
sat = 2
Sheets("Sayfa2").Range("A2:E65000").ClearContents
For r = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "E").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(r, "E").Value
say8 = 0
say11 = 0
If Sheets("Sayfa1").Cells(r, "E").Value <> "" Then
If Sheets("Sayfa1").Cells(r, "E").Value <> "İPTAL" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("E2:E" & r), aranan1) = 1 Then
For i = r To Worksheets("Sayfa1").Cells(Rows.Count, "E").End(3).Row
aranan2 = Sheets("Sayfa1").Cells(i, "E").Value
If aranan2 = aranan1 Then
say8 = say8 + CDbl(Sheets("Sayfa1").Cells(i, 8).Value)
say11 = say11 + CDbl(Sheets("Sayfa1").Cells(i, 11).Value)
End If
Next i
If say11 >= deg1 Then
Sheets("Sayfa2").Cells(sat, 1).Value = Sheets("Sayfa1").Cells(r, "F").Value
Sheets("Sayfa2").Cells(sat, 2).Value = Sheets("Sayfa1").Cells(r, "D").Value
Sheets("Sayfa2").Cells(sat, 3).Value = Sheets("Sayfa1").Cells(r, "E").Value
Sheets("Sayfa2").Cells(sat, 4).Value = say8
Sheets("Sayfa2").Cells(sat, 5).Value = say11
sat = sat + 1
End If
End If
End If
End If
Next r
MsgBox "işlem tamam"
End Sub

 

[İhsan Tank]

bu kod'da alternatif olsun

Option Explicit
Sub mük_topla_5000yukarı()
Sheets("Sayfa2").Range("A2:E65536").ClearContents
Dim r, sat, son, aranan1, ts, kaplan, trabzonspor
kaplan = 2
Sheets("Sayfa2").Columns("K:K").ClearContents
sat = 1
son = Worksheets("Sayfa1").Cells(Rows.Count, "F").End(3).Row
For r = 2 To son
aranan1 = Sheets("Sayfa1").Cells(r, "F").Value
If Sheets("Sayfa1").Cells(r, "F").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("F2:F" & r), aranan1) = 1 Then
Sheets("Sayfa2").Cells(sat, "K").Value = Sheets("Sayfa1").Cells(r, "F").Value
sat = sat + 1
End If
End If
Next r
For ts = 1 To Sheets("Sayfa2").Cells(65536, "K").End(xlUp).Row
Sheets("Sayfa2").Cells(ts, "L") = WorksheetFunction.SumIf(Sheets("Sayfa1"). _
Range("F:F"), Sheets("Sayfa2").Range("K" & ts), Sheets("Sayfa1").Range("K:K"))
If Sheets("Sayfa2").Cells(ts, "L") >= 5000 Then
Sheets("Sayfa2").Cells(kaplan, "A") = Sheets("Sayfa2").Cells(ts, "K")
kaplan = kaplan + 1
End If
Next
Sheets("Sayfa2").Range("K:L").ClearContents
For trabzonspor = 2 To Sheets("Sayfa2").Cells(65536, "A").End(xlUp).Row
Sheets("Sayfa2").Cells(trabzonspor, "B") = WorksheetFunction.Index(Sheets("Sayfa1").Range("D:F"), _
WorksheetFunction.Match(Sheets("Sayfa2").Range("A" & trabzonspor), Sheets("Sayfa1").Range("F:F"), 0), 1)
Sheets("Sayfa2").Cells(trabzonspor, "C") = WorksheetFunction.Index(Sheets("Sayfa1").Range("D:F"), _
WorksheetFunction.Match(Sheets("Sayfa2").Range("A" & trabzonspor), Sheets("Sayfa1").Range("F:F"), 0), 2)
Sheets("Sayfa2").Cells(trabzonspor, "D") = WorksheetFunction.CountIf(Sheets("Sayfa1").Range("F:F"), _
Sheets("Sayfa2").Range("A" & trabzonspor))
Sheets("Sayfa2").Cells(trabzonspor, "E") = WorksheetFunction.SumIf(Sheets("Sayfa1").Range("F:F"), _
Sheets("Sayfa2").Range("A" & trabzonspor), Sheets("Sayfa1").Range("K:K"))
Next
End Sub

 

[Huseyinkis]

ihsan hocam yardımınıza ihtiyacım var yine yenidenn

Merhaba Ekteki kodları denermisiniz , (biraz geç gördüm buda alternatifin alternatifi olsun.)

Sub Deneme()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
s1.Select
sonsat = s1.Range("B65536").End(3).Row
For i = 2 To sonsat
firma = WorksheetFunction.CountIf(s1.Range("F2:F" & i), s1.Range("F" & i))
toplam = WorksheetFunction.SumIf(s1.Range("F2:F" & sonsat), s1.Range("F" & i), s1.Range("I2:I" & sonsat)) * 1

snst = s2.Range("A65536").End(3).Row + 1

If firma <= 1 And toplam > 4999.99 Then
Frm = s1.Range("F" & i).Value
Vrgno = s1.Range("E" & i).Value
vrgd = s1.Range("D" & i).Value
Ftad = WorksheetFunction.CountIf(s1.Range("F2:F" & sonsat), s1.Range("F" & i))
s2.Select
s2.Range("A" & snst).Value = Frm
s2.Range("B" & snst).Value = vrgd
s2.Range("C" & snst).Value = Vrgno
s2.Range("D" & snst).Value = Ftad
s2.Range("E" & snst).Value = toplam
s1.Select
End If
Next
End Sub

 

[derdalan58]

arkadaşlar yardımcı olanlardan allah razı olsun..tam da istediğim buydu.allaha emanet olun

 

[halit3]

arkadaşlar yardımcı olanlardan allah razı olsun..tam da istediğim buydu.allaha emanet olun

Bu kodlar genel olarak hemsi aynı işi yapıyor ama farklı farklı yapıyor sizin işinizi hangisi gördü bunu sormamın nedeni sorunuzu tam olarak anlıyamadığımdan dolayı soruyorum.

 

[derdalan58]

halit bey kusura bakmayın ancak gördüm mesajınızı.hüseyin beyin verdiği kodlarla çözdüm problemimi.