Döngü Hakkında

[ahmedummu]

Merhaba arkadaşlar.

[b65000].End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 1) = ""
ActiveCell.Offset(0, 2) = ""
ActiveCell.Offset(0, 3) = ""
ActiveCell.Offset(0, 4) = ""
ActiveCell.Offset(0, 5) = ""
ActiveCell.Offset(0, 6) = ""

ActiveCell.Offset(0, 1) = WorksheetFunction.Sum(Range("c2:c65000").Value)
ActiveCell.Offset(0, 2) = WorksheetFunction.Sum(Range("d2:d65000").Value)
ActiveCell.Offset(0, 3) = WorksheetFunction.Sum(Range("e2:e65000").Value)
ActiveCell.Offset(0, 4) = WorksheetFunction.Sum(Range("f2:f65000").Value)
ActiveCell.Offset(0, 5) = WorksheetFunction.Sum(Range("g2:g65000").Value)
ActiveCell.Offset(0, 6) = WorksheetFunction.Sum(Range("h2:h65000").Value)

Yukarıda ayrı ayrı iki kod bloğu var. Yaptığım her döngüde hata verdi kesinlikle çalışmadı. Yardımcı olabilir misiniz.

 

[Muzaffer Ali]

ActiveCell.Offset(0, 1) = WorksheetFunction.Sum([COLOR="red"]Range([/COLOR]"c2:c65000"[COLOR="Red"]).Value[/COLOR])

şeklinde olan satırları aşağıdaki şekilde değiştirmelisin.

ActiveCell.Offset(0, 1) = WorksheetFunction.Sum("c2:c65000")

diğer sorun hakkında fikrim yok. Ama eğer dosyanızı eklerseniz sorunu çözebiliriz.

 

[ahmedummu]

Teşekkürler.

Dosyayı ekliyorum.

Her iki kod bloğu da döngü ile olacak.

 

[Muzaffer Ali]

O kodlar yerine aşağıdakini kopyalayın.

Private Sub CommandButton2_Click()
    Dim Bak As Long
    [b65000].End(xlUp).Select
    ActiveCell.Offset(1, 0).Select
    For Bak = 1 To 6
        ActiveCell.Offset(0, Bak) = WorksheetFunction.Sum(Range("c2:c65000").Value)
    Next
End Sub

 

[halit3]

Merhaba arkadaşlar.

[b65000].End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(0, 1) = ""
ActiveCell.Offset(0, 2) = ""
ActiveCell.Offset(0, 3) = ""
ActiveCell.Offset(0, 4) = ""
ActiveCell.Offset(0, 5) = ""
ActiveCell.Offset(0, 6) = ""

ActiveCell.Offset(0, 1) = WorksheetFunction.Sum(Range("c2:c65000").Value)
ActiveCell.Offset(0, 2) = WorksheetFunction.Sum(Range("d2:d65000").Value)
ActiveCell.Offset(0, 3) = WorksheetFunction.Sum(Range("e2:e65000").Value)
ActiveCell.Offset(0, 4) = WorksheetFunction.Sum(Range("f2:f65000").Value)
ActiveCell.Offset(0, 5) = WorksheetFunction.Sum(Range("g2:g65000").Value)
ActiveCell.Offset(0, 6) = WorksheetFunction.Sum(Range("h2:h65000").Value)

Yukarıda ayrı ayrı iki kod bloğu var. Yaptığım her döngüde hata verdi kesinlikle çalışmadı. Yardımcı olabilir misiniz.

kod

Private Sub CommandButton2_Click()

sayfa = "Sayfa1" 'ActiveSheet.Name
son = Worksheets(sayfa).Cells(Rows.Count, 2).End(3).Row

For i = 3 To 8
Sheets(sayfa).Cells(son + 1, i).Value = WorksheetFunction.Sum(Sheets(sayfa).Range(Sheets(sayfa).Cells(2, i), Sheets(sayfa).Cells(son, i)).Value)
Next i
End Sub

 

[ahmedummu]

Çok teşekkürler arkadaşlar. Ellerinize sağlık.

Activecell.Offset(0,-1)MergeCells=True

Aktif hücre ile bir solundaki iki hücreyi birleştirmek istiyorum. Yukarıdaki kodu denedim olmadı. Bunun içinde yardımcı olursanız sevinirim.

 

[YUSUF44]

If ActiveCell.Column > 1 Then Range(ActiveCell, ActiveCell.Offset(0, -1)).MergeCells = True

Şeklinde deneyiniz.

 

[halit3]

Alternatif kod

sat = ActiveWindow.RangeSelection.Row
sut = ActiveWindow.RangeSelection.Column
If sut > 1 Then Range(Cells(sat, sut - 1), Cells(sat, sut)).Merge

 

[ahmedummu]

Halit Bey çok teşekkür ederim. Ellerine sağlık.

 

[ahmedummu]

Merhaba,

Halit bey, kusura bakmayın aktif satırın bir alt satırı olacaktı. Alternatif olarak gönderdiğiniz ikinci kod aktif satırın alt satırı birleştiriliyor fakat ikinci bir kayıt yapılırken birleştirilen hücrelerin tekrar çözülmesii gerekiyor. İlk gönderdiğiniz kodu, Aktif satırın bir alt satırının birleşmesi ve tekrar çözülmesi için gönderirseniz sevinirim. Tabi mümkünse.

 

[halit3]

kod:

Sub birlestir()
sat = ActiveWindow.RangeSelection.Row [COLOR="Red"]+ 1[/COLOR]
sut = ActiveWindow.RangeSelection.Column
If sut > 1 Then Range(Cells(sat, sut - 1), Cells(sat, sut)).Merge

End Sub

Sub coz()
sat = ActiveWindow.RangeSelection.Row [COLOR="red"]+ 1[/COLOR]
sut = ActiveWindow.RangeSelection.Column
If sut > 1 Then Range(Cells(sat, sut - 1), Cells(sat, sut)).UnMerge

End Sub

 

[ahmedummu]

Yusuf bey kusura bakmayın yeni farkettim. Size de çok teşekkür ederim.