- Katılım
- 20 Ocak 2008
- Mesajlar
- 12
- Excel Vers. ve Dili
- office xp tr
arkadaşlar ekte vermiş olduğum dosyayı inceler bana yardım ederseniz sevinirim.
Ekli dosyalar
-
113.5 KB Görüntüleme: 37
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C1]) Is Nothing Then Exit Sub
Dim S1 As Worksheet
Dim c As Range
Dim sat, son, i As Long
Dim ilkadres As Variant
Set S1 = Sheets("SATIŞ FATURA GİRİŞ")
Application.ScreenUpdating = False
Range("B6:I65536").ClearContents
sat = 5
son = S1.[F65536].End(3).Row
Set c = S1.Range("F3:F" & son).Find(Range("C1"), LookIn:=xlValues)
If Not c Is Nothing Then
ilkadres = c.Address
Do
sat = sat + 1
Cells(sat, "B") = S1.Cells(c.Row, "D")
Cells(sat, "E") = S1.Cells(c.Row, "I")
Cells(sat, "F") = S1.Cells(c.Row, "G")
Cells(sat, "G") = S1.Cells(c.Row, "H")
Set c = S1.Range("F3:F" & son).FindNext(c)
Loop While Not c Is Nothing And c.Address <> ilkadres
End If
For i = 6 To [B65536].End(3).Row
Cells(i, "H") = "=IF(RC[-6]="""","""",SUM(R6C6:RC[-2])-SUM(R6C7:RC[-1]))"
Cells(i, "I") = "=IF(RC[-7]="""","""",IF(RC[-1]>0,""B"",""A""))"
Next i
Application.ScreenUpdating = True
End Sub
benim düşündüğüm böyle birşey değildiBakiye ek alan eklemekten öte ben bu formülü uyguluyorum
ama özelliklerden satır ve sütun toplamlarını kaldırıyorum