Soru Şarta göre toplam aldırma makroyla

[Seli]

Arkadaşlar merhaba, dün bir sorum olmuştu ancak başka bir düzenleme yapmam gerekti çünkü bolt ve welded oldugunda toplamı farklı aldırması gerekıyormus. Excel dosyasında acıklamaya calıstım, kodu bu sekılde nasıl duzenleyebilirm? Çok teşekkür ederim şimdiden..

deneme.xlsm

drive.google.com

 

[YUSUF44]

Bunu yapmak zor çünkü örnek dosyanızda H sütunu hep dolu. Boş görünen hücrelerde daha önce bahsettiğim gibi boşluk karakterleri var.

 

[Seli]

Hocam şöyle olur mu, o satırda eğer h sütunu boşsa toplama alacagı degerı 0 alsın öyle toplasın.. Normalde k dan alıyordu degerını h boşsa sıfır olarak algılasın..

 

[YUSUF44]

Hatta K sütunu haricindeki tüm hücrelerde verilerinizin sonunda boşluk karakteri var. Örneğin "Welded" değil "Welded " yazıyor, yani 94 tane boşluk var.

Yine de aşağıdaki kodları bir deneyin:

Sub seli_bw()
Dim son, sat, toplam, toplama As Integer
son = Cells(Rows.Count, "K").End(3).Row
For toplam = 2 To son
    toplama = 0
    If Cells(toplam, "A") = "Welded                                                                                              " Or Cells(toplam, "A") = "Bolt" Then
        For sat = toplam + 1 To son
            If IsNumeric(Cells(sat, "K")) Then
                If Len(Trim(Cells(sat, "H"))) > 0 Then
                    toplama = toplama + Cells(sat, "K")
                End If
            Else
                Cells(toplam, "K") = toplama
                toplam = sat - 1
                sat = son
            End If
        Next
    Else
        For sat = toplam + 1 To son
            If IsNumeric(Cells(sat, "K")) Then
                toplama = toplama + Cells(sat, "K")
            Else
                Cells(toplam, "K") = toplama
                toplam = sat - 1
                sat = son
            End If
        Next
    End If
Next
End Sub

 

[YUSUF44]

Hocam şöyle olur mu, o satırda eğer h sütunu boşsa toplama alacagı degerı 0 alsın öyle toplasın.. Normalde k dan alıyordu degerını h boşsa sıfır olarak algılasın..

Yukarda kod verdim ama şunu anlamanız lazım, "dosyanızda boş hücre yok". Boş diye düşündüğünüz tüm hücrelerde bir çok boşluk karakteri var.

Anladığım kadarıyla bu verileri başka bir programdan alıyorsunuz. Program da her sütunda belirli bir uzunluğa kadar boşluk ekliyor. Mesela H sütununu hep 40 karakter olarak ayarlamış. H sütununda 8 karakterlik bir veri varsa arkasına 32 tane boşluk ekliyor, boşsa doğrudan 40 tane boşluk ekliyor. Aynı şekilde A, B ve C sütunları 100 karakter, D ve J sütunları 40 karakter, F sütunu 50 karakter, G sütunu 20, İ sütunu ise 18 karakter olarak ayarlanmış.

Örneğin tablo dışındaki bir hücreye

=UZUNLUK(H35)

formülünü yazarsanız boş görünen H35 hücresinin 40 karakter olduğunu görebilirsiniz.

 

[YUSUF44]

Bu arada verdiğim makroda For toplam = 2 to son kısmını For toplam = 20 to son olarak düzeltin.

 

[Seli]

Hocam oldu sadece şu kısımda
For sat = toplam + 1 To son
If IsNumeric(Cells(sat, "K")) Then
toplama = toplama + Cells(sat, "K")
Else
Cells(toplam, "K") = toplama
toplam = sat - 1
sat = son
End If
Next

k20 den nasıl baslatabilirim?

 

[Seli]

Hocam sımdı gordum yazdıgınızı bende onu sormustum cok cok tesekkur ederııım..

 

[Korhan Ayhan]

Konu çözümlendi dediniz ama kafama takıldığı için sormak istedim.

K37 hücresinde neden 2 yazması gerekiyor?

Kontrol ederseniz sadece H38 dolu ve buna karşılık K38 hücresinde 1 değeri var. H37 hücresine karşılık gelen K37 hücresi zaten boş ve toplam alınacak hücre durumunda. Bana burası anlamsız geldi.

Ayrıca ifadenizde "Eğer Welded ve bolt ise H sütununa baksın..." koyu renkli bölüm yazının kalın olması mı dır? Eğer öyleyse paylaştığınız dosyada ben kalın yazı karakteri göremedim.

 

[YUSUF44]

Korhan Bey, H41 de dolu olduğu için toplama ekleniyor. Toplama işlemi A sütunundaki dolu (daha doğrusu boşluk dışında karakter içeren) hücreler arasında yapılıyor.

 

[Seli]

Evet hocam welded ve bolt dışında h ta boşluk yok bu nedenle aldırdık.. Ama welded bolt kısıtını cıkarırsak yıne aynı sekılde calısır dıye dusunuyorum cunku boş olanı alıyor degıl mı hocam?

 

[Korhan Ayhan]

Bu tabloda boşlukların bir anlam ifade etmediğini düşünerek A20:A... ve H20:H.... aralığındaki boşlukları kaldırarak aşağıdaki kodu hazırladım.

Kod aynı zamanda toplam aldığı hücreleri sarı renk yapıyor. Dilerseniz döngü içindeki 2. satırı silerek bu özelliği kaldırabilirsiniz.

Option Explicit

Sub Alt_Toplam_Al()
    Dim Veri As Range

    Range("A20:A" & Rows.Count).Replace What:=" ", Replacement:="", LookAt:=xlPart
    Range("H20:H" & Rows.Count).Replace What:=" ", Replacement:="", LookAt:=xlPart
    
    Range("K20:K" & Rows.Count).Interior.ColorIndex = -4142
    
    For Each Veri In Range("A20:A" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeBlanks).Areas
        Veri.Cells(1, 1).Offset(-1, 10) = WorksheetFunction.Sum(Veri.Offset(, 7).SpecialCells(xlCellTypeConstants, 23).Offset(, 3))
        Veri.Cells(1, 1).Offset(-1, 10).Interior.ColorIndex = 6
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Seli]

Hocam cok teşekkür ederim tek calıstırdıgımda calıstı ancak asıl kullanacagım makronun ıcıne yazınca hata verıyor. Sizden ricam SELİ butonuna basmanız daha sonra da ref sekmesi butonuna basablir misiniz, neden calısmıyor anlayamadım ..

 

[Seli]

deneme.xlsm

drive.google.com

Hocam burda dosya.. Şimdiden cok cok teşekkür ederiim..

 

[Korhan Ayhan]

Benim önerdiğim kod A20:A.... sonrasındaki boşlukları kaldırıyor. Siz diğer kodunuzda A sütununa göre işlemler yaptırıyorsunuz. Doğal olarak hata verebilir.

Benim önerdiğim kod da A sütununu referans alan bölümü B olarak düzeltirseniz sorun düzelecektir.

Option Explicit

Sub Alt_Toplam_Al()
    Dim Veri As Range

    Range("B20:B" & Rows.Count).Replace What:=" ", Replacement:="", LookAt:=xlPart
    Range("H20:H" & Rows.Count).Replace What:=" ", Replacement:="", LookAt:=xlPart
    
    Range("K20:K" & Rows.Count).Interior.ColorIndex = -4142
    
    For Each Veri In Range("B20:B" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeBlanks).Areas
        Veri.Cells(1, 1).Offset(-1, 9) = WorksheetFunction.Sum(Veri.Offset(, 6).SpecialCells(xlCellTypeConstants, 23).Offset(, 3))
        Veri.Cells(1, 1).Offset(-1, 9).Interior.ColorIndex = 6
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Seli]

Hocam calıstı sadece mıktarı bu sekılde e lı getırdı tek boşluk olunca yanlıs getırdı hocam..

deneme.xlsm

drive.google.com

​

 

[Korhan Ayhan]

Ne demek istediğinizi anlamadım.

 

[Seli]

Hocam oldu cok teşekkür ederim, ben yanlıs anlamısım.. Emeğinize sağlık..