mükerer verileri toplama ve alt mükerre satırı silme

[barisy]

Sütunda mükerrer verilere karşılık gelen veriyi toplama ve alt mükerrer satırı silme işlemini nasıl yapabilirim şimdiden teşekkür ederim.

 

[Ferhat Pazarçevirdi]

Aşağıdaki kodu, standart bir module sayfasına kopyalayıp, çalıştırınız.

Sub Mukerrerleri_Topla_ve_Temizle()
    
    Dim col As New Collection
    Dim rng As Range
    Dim i As Integer
    Dim iSon As Integer
    Dim x As Integer
    
    iSon = Cells(65536, 1).End(xlUp).Row
    
    On Error Resume Next
    
    Application.Calculation = xlCalculationManual
    
    For i = 2 To iSon
        
        col.Add CStr(Cells(i, 1)), CStr(Cells(i, 1))
        
        If Err <> 0 Then
            x = x + 1
            
            If x = 1 Then
                Set rng = Rows(i)
            Else
                Set rng = Application.Union(rng, Rows(i))
            End If
            
            Err = 0
        Else
            Cells(i, "D") = Application.WorksheetFunction.SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("D2:D" & iSon))
        End If
    Next
    
    On Error GoTo 0
    
    If Not rng Is Nothing Then
            rng.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    
    Set rng = Nothing
 
End Sub

 

[zünnun]

peki bunu türkçe excel yazsam olurmu birde tam olarak anlamadım nereye yazacam bu kodu yada hangi bölüme , benimde işime yarar gibi selam ve dua ile

 

[kelkitli]

Selamlar,
Ferhat Hocanın kodlarıyla dosyanız ekte.

 

[zünnun]

arkadaş saolda benim bunun nasıl yapıldığınıda öğrenmem lazım yoksa hep seni ararım biraz bağımsız olmak laızm ama genede saol

 

[tahsinanarat]

sn. ferhat hocam, eğer toplanacak sutun birden fazla olsaydı kod nasıl olacaktı, örnekte d sutunu toplanıpor,
bununla birlikte b ve h sutunuda toplanacak olsaydı.

 

[Ferhat Pazarçevirdi]

sn. ferhat hocam, eğer toplanacak sutun birden fazla olsaydı kod nasıl olacaktı, örnekte d sutunu toplanıpor,
bununla birlikte b ve h sutunuda toplanacak olsaydı.

O zaman, SumIf fonksiyonunu 3 sütuna göre ayrı ayrı hesap edip toplamlarını alacaktık. Bölyece kodumuz da şöyle olacaktı :

Not : Değiştirilen ve eklenen kısımlar kırmızı ile gösterilmiştir.

Sub Mukerrerleri_Topla_ve_Temizle()
    
    Dim col As New Collection
    Dim rng As Range
    Dim i As Integer
    Dim iSon As Integer
    Dim x As Integer
[COLOR=red]    Dim dblTop As Double[/COLOR]
    
    iSon = Cells(65536, 1).End(xlUp).Row
    
    On Error Resume Next
    
    Application.Calculation = xlCalculationManual
    
    For i = 2 To iSon
        
        col.Add CStr(Cells(i, 1)), CStr(Cells(i, 1))
        
        If Err <> 0 Then
            x = x + 1
            
            If x = 1 Then
                Set rng = Rows(i)
            Else
                Set rng = Application.Union(rng, Rows(i))
            End If
            
            Err = 0
        Else
[COLOR=red]            With Application.WorksheetFunction
                dblTop = .SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("D2:D" & iSon))
                dblTop = dblTop + .SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("B2:B" & iSon))
                dblTop = dblTop + .SumIf(Range("A2:A" & iSon), Cells(i, 1), Range("H2:H" & iSon))
            End With
            Cells(i, "D") = dblTop[/COLOR]
        End If
    Next
    
    On Error GoTo 0
    
    If Not rng Is Nothing Then
            rng.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    
    Set rng = Nothing
 
End Sub

 

[tahsinanarat]

Çok teşekkür ederim hocam, sağolun varolun.

 

[barisy]

Kodları Türkçe açıklamaları ile hazırlarmısnız? amacım toplama yaptığı "d" sütunu ve mükerer kontrolünü yaptığı "a" sütunun değiştirebilmek şimdiden teşekkürler. Birde toplama ve mükerrer kayıt silme işlemini kayıt girdikce toplama ve silme yaptrabilirmiyiz.şimdiden teşekkürler