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

Katılım
30 Nisan 2008
Mesajlar
23
Excel Vers. ve Dili
2010 türkçe
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
 

Ekli dosyalar

İ

İhsan Tank

Misafir
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

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,850
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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.

Kod:
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

Misafir
bu kod'da alternatif olsun
Kod:
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
 
Katılım
23 Eylül 2004
Mesajlar
1,754
Excel Vers. ve Dili
Excel 2010 TR
ihsan hocam yardımınıza ihtiyacım var yine yenidenn
Merhaba Ekteki kodları denermisiniz , (biraz geç gördüm buda alternatifin alternatifi olsun.)

Kod:
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
 
Katılım
30 Nisan 2008
Mesajlar
23
Excel Vers. ve Dili
2010 türkçe
arkadaşlar yardımcı olanlardan allah razı olsun..tam da istediğim buydu.allaha emanet olun
 

halit3

Uzman
Uzman
Katılım
18 Ocak 2008
Mesajlar
12,850
Excel Vers. ve Dili
2003 excell türkçe
ve
2007 excell türkçe
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.
 
Katılım
30 Nisan 2008
Mesajlar
23
Excel Vers. ve Dili
2010 türkçe
halit bey kusura bakmayın ancak gördüm mesajınızı.hüseyin beyin verdiği kodlarla çözdüm problemimi.
 
Üst