Son dolu hücrenin bir altında Toplam alma

[DeliBalta58]

Eczane_Listesi.xls de veriler iki ayrı kitaptan alınıp aktarılıyor.

Sub eczane_listesi()
Dim i As Integer
Dim sayi As Integer
Dim sy As Integer
Dim a As Integer
Workbooks.Open ThisWorkbook.Path & "\personel_bilgi.xls"
Workbooks.Open ThisWorkbook.Path & "\eczaneler.xls"
Workbooks("eczane_listesi.xls").Worksheets("sayfa1").Activate
Range("A2:BJ1000").ClearContents
Range("A1").Select
Set prs = Workbooks("personel_bilgi.xls").Worksheets("sayfa3")
Set ecz = Workbooks("eczaneler.xls").Worksheets("sayfa1")
Set eczn = Workbooks("eczane_listesi.xls").Worksheets("sayfa1")
sayi = WorksheetFunction.CountA(prs.[B2:B65000])
For i = 1 To sayi + 1
eczn.Cells(i + 1, 2) = prs.Cells(i + 1, 2) & " " & prs.Cells(i + 1, 3)
eczn.Cells(i + 1, 3) = prs.Cells(i + 1, 12)
eczn.Cells(i, 1) = prs.Cells(i, 1)
Next i
son = WorksheetFunction.CountA(eczn.[B2:B65000])
eczn.Cells(son + 2, 2).Select
ActiveCell.Offset(0, -1).ClearContents
ActiveCell.Offset = "TOPLAMLAR"

'Toplamlar Buraya Alınacak
Range("A1").Select
End Sub

Yapmak istediğim ;
eczaneler_listesine verileri aktarıyorum.

son = WorksheetFunction.CountA(eczn.[B2:B65000])
eczn.Cells(son + 2, 2).Select
ActiveCell.Offset(0, -1).ClearContents
ActiveCell.Offset = "TOPLAMLAR"

Kodu il enson dolu satırın 2 altına TOPLAMLAR yazdırdım
Aynı satırda D-E-F-G-H-I-sütun toplamlarını ayrı ayrı almam gerekli
Yanlız buraya formül girmeliyim çünkü veri aktarımı bittikten sonra değer gireceğim .

=TOPLA.ÇARPIM((YUVARLA((D2:D39);2)))

=TOPLA.ÇARPIM((YUVARLA((E2:E39);2)))

=TOPLA.ÇARPIM((YUVARLA((F2:F39);2)))

=TOPLA.ÇARPIM((YUVARLA((G2:G39);2)))

=TOPLA.ÇARPIM((YUVARLA((I2:I39);2)))

Yanlız dikkat edilmesi gereken eğer personel sayısı artarsa bu formül bir alt satıra kayması gerekli
((D239) olarak kalmayacak
((D240) olacak bir ekleme daha olursa
((D241) diye gidecek

Dosya ekte

 

[xxcell]

Aşağıdaki kodu kendine göre geliştir, işini görür.

ActiveCell.Offset(0, 3).Formula = "=sumproduct((round((d2:d" & son & " ),2)))"
ActiveCell.Offset(0, 4).Formula = "=sumproduct((round((e2:e" & son & " ),2)))"
ActiveCell.Offset(0, 5).Formula = "=sumproduct((round((f2:f" & son & " ),2)))"
ActiveCell.Offset(0, 6).Formula = "=sumproduct((round((g2:g" & son & " ),2)))"

 

[xxcell]

Hücreler göreceli olarak girildiğinden araya satır açıldığında formul kendiliğinden değişecektir.

Ayrıca FORMULA özelliğinde fonkisyonları türkçe yazamazsınız. Yani
[a1].formula = "=alttoplam(9;a1:a2)"

şeklinde değil,

ingilizce haliyle (worksheetfunction ile kullanır gibi)

[A1].FORMULA= "SUBTOTAL(9,A1:A2)"

şeklinde yazmalisiniz. ; yerine , geldiğine de dikkat edin.

 

[DeliBalta58]

Evet. Teşekkürler Tam da istediğim gibi.

=TOPLA.ÇARPIM((YUVARLA((G2:G39);2)))
formülünü sayfa üzerinden kopyalamıştım.

 

[DeliBalta58]

Bir sorum daha olacak mümkünse.
Aynı dosyada

sy = WorksheetFunction.CountA(ecz.[B2:B65000])
For a = 1 To sy
eczn.Cells(1, a + 3) = ecz.Cells(a + 1, 2) & "                                  " & ecz.Cells(a + 1, 3)
Next a

kodu ile eczane isimlerini 1.satıra yazdırıyorum.
1. Satıra en son eczaneyi yazdıktan sonra ki Hücreye TOPLAMLAR yazacak
bu defada Satır toplamları alması gerekli

 

[xxcell]

Kod şöyle yine sen düzenlersin.

ECZN.CELLS(1,a+3+1).formula=" = SUM(A4:A" & A+3 & ")"

 

[xxcell]

Yanlız ; Toplamlar dediğin hücre erimini kendine göre düzeltmen gerekli.

 

[DeliBalta58]

Hocam sayfada kullandığı formülü yazayım yine

=TOPLA.ÇARPIM((YUVARLA((D2:F2 );2)))

eğer bir eczane eklemesi daha olursa
=TOPLA.ÇARPIM((YUVARLA((D2:G2 );2)))

=TOPLA.ÇARPIM((YUVARLA((D2:H2 );2)))
diye satırları toplamalı

ActiveCell.Offset(0, 2).Formula = "=sumproduct((round((d2:d" & son & " ),2)))"

bu formülde sütun toplamı alınıyor.

For aa = 1 To sy
eczn.Cells(1, sy + 4).Select
ActiveCell.Offset.Value = "TOPLAMLAR"
eczn.Cells(aa + 1, sy + 4).Formula = "= SUM(D2:d" & sy + 3 & ")"  [COLOR="Red"] ' Sıkıntı burda[/COLOR]
Next aa

bu şekilde satır toplamını alabilmeliyim.

 

[xxcell]

.... d2: d" & sy + 3

hücre erimi vermişsin. Satır toplamak istiyorsan a1:d1 gibi bir erim olmalıydı. Ben hangi erimi toplamak istediğini bilmiyorum. örnek dosyanda takıldığın yeri gösterirsen daha anlaşılır.

 

[DeliBalta58]

Dosyayı yeniden son talebine göre düzenleyip ekledim.

 

[xxcell]

İlgili kısmı şöyle düzenlersen olucak gibi. Yanlız ben hala toplamak istediğin hücre erimini anlamadım orasını sen çöz

eczn.Cells(1, sy + 4) = "TOPLAMLAR"
For n = 2 To [a65536].End(xlUp).Row
eczn.Cells(n, sy + 4).Formula = "= SUM(" & Cells(n, 4).Address & ":" & Cells(n, sy + 3).Address & ")"
Next n

 

[DeliBalta58]

Yanlız ben hala toplamak istediğin hücre erimini anlamadım orasını sen çöz

"hücre erimini" derken ne kastettiğimizi çözemedim.
Ancak benim sorunu çözmüşsünüz. Teşekkürler