Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: Bedrettin - 21 Aralık 2023, 16:44:51

Başlık: Yardım rica ediyorum
Gönderen: Bedrettin - 21 Aralık 2023, 16:44:51

Merhaba Arkadaşlar
Aşağıdaki konu hakkında yardımcı olursanız çok memnun olurum

Aşağıdaki kod grup toplam alıyor
2 satır ve fazlasında doğru toplam alıyor fakat  tek satır varsa toplamayı iki satırdan yapıyor
tek satır olabilir mi ?


Sub cari_mirac()
  Application.ScreenUpdating = False
    For i = Range("a65").End(3).Row To 2 Step -1
      If Range("a" & i).Value <> Range("a" & i - 1).Value Then
        If i = 2 Then i = -1 Else Range("a" & i & ":a" & i + 1).EntireRow.Insert
        sat = IIf(Application.CountBlank(Range(Range("c" & i + 3), Range("c" & i + 3).End(4))) > 0, 1, Range("c" & i + 3).End(4).Row - i - 2)
       
        Range("c" & i + 3).Offset(sat, 0).Formula = "=SUM(R[-" & sat + 1 & "]C:R[-1]C)"
        Range("b" & i + 3).Offset(sat, 0).Value = "TOPLAM : "
        Range("b" & i + 3).Offset(sat, 0).HorizontalAlignment = xlRight
         Range("c" & i + 3).End(4).Offset(0, 0).Font.Color = 12458
         Range("c" & i + 3).End(4).Offset(0, 0).Font.Bold = True
      End If
    Next
  Application.ScreenUpdating = True
 
End Sub

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bedrettin - 21 Aralık 2023, 16:45:58

Eğer Excel örnek dosya isterseniz paylaşabilirim

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bülent Öztürk - 22 Aralık 2023, 23:58:26

Merhaba Bedrettin Bey,

Ekran görüntüsü veya örnek dosya üzerinde anlatabilir misiniz yapılmak istenen işlemi?

Teşekkürler.

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bedrettin - 23 Aralık 2023, 09:06:18

ÖRNEK DOSYAYI YÜKLEDİM

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bülent Öztürk - 23 Aralık 2023, 11:16:57

Ekli dosyayı kontrol eder misiniz?

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bedrettin - 23 Aralık 2023, 12:33:16

dosya bende açılmıyor
hasarlı diye uyarı veriyor Bülent bey

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bülent Öztürk - 23 Aralık 2023, 12:35:53

Kodu şu şekilde değiştirdim:

Kod: [Seç]

Sub cari_mirac()
 Application.ScreenUpdating = False
    For i = Range("a65536").End(3).Row To 2 Step -1
      If Range("a" & i).Value <> Range("a" & i - 1).Value Then
        'Range("a" & i & ":a" & i + 2).EntireRow.Insert
        If i = 2 Then i = 0 Else Range("a" & i & ":a" & i + 1).EntireRow.Insert
        sat = IIf(Application.CountBlank(Range(Range("c" & i + 3), Range("c" & i + 3).End(4))) > 0, 1, Range("c" & i + 3).End(4).Row - i - 2)
       
        If sat = 1 Then
           Range("c" & i + 2).Offset(sat, 0).Formula = "=SUM(R[-" & sat & "]C:R[-1]C)"
           Range("b" & i + 2).Offset(sat, 0).Value = "TOPLAM : "
           Range("b" & i + 2).Offset(sat, 0).HorizontalAlignment = xlRight
           
           Range("E" & i + 2).Offset(sat, 0).Formula = "=SUM(RC[-2]+RC[-2]*20%)"
       
           Range("E" & i + 2).End(4).Offset(0, 0).Font.Color = 12458
           Range("E" & i + 2).End(4).Offset(0, 0).Font.Bold = True
       
       
           Range("c" & i + 2).End(4).Offset(0, 0).Font.Color = 12458
           Range("c" & i + 2).End(4).Offset(0, 0).Font.Bold = True
           
           Range("B" & i + 2).End(4).Offset(0, 0).Font.Color = 12458
           Range("B" & i + 2).End(4).Offset(0, 0).Font.Bold = True
           
           Range("E" & i + 2).End(4).Offset(0, 0).Font.Color = 12458
           Range("E" & i + 2).End(4).Offset(0, 0).Font.Bold = True
           Range("E" & i + 2).End(4).Offset(0, 0).NumberFormat = "#,##0.00"

        Else
           Range("c" & i + 3).Offset(sat, 0).Formula = "=SUM(R[-" & sat + 1 & "]C:R[-1]C)"
           Range("b" & i + 3).Offset(sat, 0).Value = "TOPLAM : "
           Range("b" & i + 3).Offset(sat, 0).HorizontalAlignment = xlRight
           
           Range("E" & i + 3).Offset(sat, 0).Formula = "=SUM(RC[-2]+RC[-2]*20%)"
       
           Range("E" & i + 3).End(4).Offset(0, 0).Font.Color = 12458
           Range("E" & i + 3).End(4).Offset(0, 0).Font.Bold = True
       
       
           Range("c" & i + 3).End(4).Offset(0, 0).Font.Color = 12458
           Range("c" & i + 3).End(4).Offset(0, 0).Font.Bold = True
           
           Range("B" & i + 3).End(4).Offset(0, 0).Font.Color = 12458
           Range("B" & i + 3).End(4).Offset(0, 0).Font.Bold = True
           
           Range("E" & i + 3).End(4).Offset(0, 0).Font.Color = 12458
           Range("E" & i + 3).End(4).Offset(0, 0).Font.Bold = True
           Range("E" & i + 3).End(4).Offset(0, 0).NumberFormat = "#,##0.00"
       
        End If
      End If
    Next
   
'Call ALT_TOPLAM_AL
 
  Application.ScreenUpdating = True
 
End Sub

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bülent Öztürk - 23 Aralık 2023, 13:20:39

Ekli dosyayı dener misini?

Başlık: Ynt: Yardım rica ediyorum
Gönderen: Bedrettin - 23 Aralık 2023, 20:26:03

Teşekkür ederim
ama hata var
tek satır olduğu zaman hata vermiyor
ama iki satırsa hata veriyor
toplamı ikinci satırın altına yapması gerekirken ikinci satıra yapıyor