- Katılım
- 7 Ocak 2008
- Mesajlar
- 8
- Excel Vers. ve Dili
- excel 2007 tr
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Lütfen ba bs için yardım edermisiniz
daha önce bir kaç dosya ya baktım fakat bu ekteki şekilde olmasını istiyorum
formülleri diğer yerden kopyalama usülünü bağa denedim ama olmadı
ektei dosyayı incelerseniz çok sevinirim....
Sub aktar()
Sheets("Babs").Range("A4:C65000").ClearContents
Sheets("Babs").Range("A4:C65000").Interior.ColorIndex = xlNone
sat = 4
son = Worksheets("Kdv").[b65536].End(3).Row
For r = 6 To son
aranan1 = Sheets("Kdv").Cells(r, 3).Value
say1 = 0
say2 = 0
If WorksheetFunction.CountIf(Worksheets("Kdv").Range("C6:C" & r), aranan1) = 1 Then
For j = r To son
aranan2 = Sheets("Kdv").Cells(j, 3).Value
If aranan2 = aranan1 Then
say1 = say1 + CDbl(Sheets("Kdv").Cells(j, 4).Value)
say2 = say2 + 1
End If
Next j
End If
If Sheets("Kdv").Cells(r, 3).Value <> "" Then
If say1 > Sheets("Babs").Cells(1, 3).Value Then
Sheets("Babs").Cells(sat, 1).Value = Sheets("Kdv").Cells(r, 3).Value
Sheets("Babs").Cells(sat, 2).Value = say1
Sheets("Babs").Cells(sat, 3).Value = say2
sat = sat + 1
End If
End If
Next r
Sheets("Babs").Cells(sat + 1, 1).Value = "Babs SAYFASI TOPLAMI"
Sheets("Babs").Cells(sat + 1, 2).Value = WorksheetFunction.Sum(Worksheets("Babs").Range("b4:b" & sat + 1))
Sheets("Babs").Cells(sat + 1, 3).Value = WorksheetFunction.Sum(Worksheets("Babs").Range("c4:c" & sat + 1))
Sheets("Babs").Range("A" & sat + 1 & ":c" & sat + 1).Interior.ColorIndex = 40
Sheets("Babs").Cells(sat + 3, 1).Value = "Kdv sayfası TOPLAMI"
Sheets("Babs").Cells(sat + 3, 2).Value = WorksheetFunction.Sum(Worksheets("Kdv").Range("F6:F" & son))
Sheets("Babs").Cells(sat + 3, 3).Value = WorksheetFunction.CountA(Worksheets("Kdv").Range("C6:C65000"))
Sheets("Babs").Range("A" & sat + 3 & ":c" & sat + 3).Interior.ColorIndex = 6
Sheets("Babs").Cells(sat + 2, 1).Value = "fark TOPLAMI"
Sheets("Babs").Cells(sat + 2, 2).Value = Sheets("Babs").Cells(sat + 3, 2).Value - Sheets("Babs").Cells(sat + 1, 2).Value
Sheets("Babs").Cells(sat + 2, 3).Value = Sheets("Babs").Cells(sat + 3, 3).Value - Sheets("Babs").Cells(sat + 1, 3).Value
Sheets("Babs").Range("A" & sat + 2 & ":c" & sat + 2).Interior.ColorIndex = 8
End Sub
Lütfen ba bs için yardım edermisiniz
daha önce bir kaç dosya ya baktım fakat bu ekteki şekilde olmasını istiyorum
formülleri diğer yerden kopyalama usülünü bağa denedim ama olmadı
ektei dosyayı incelerseniz çok sevinirim....
.
Dosyanız ekte.
.