Microsoft Office Excel ® Kod Kılavuzu

Microsoft Office Excel® Code Guide

20 Temmuz 2005 Çarşamba

Rate and Collectors Group

'Module1

Option Explicit
Dim Hücre, Adet
Dim Toplam As Double
Dim Adres As String

Sub GruplandırVeTopla()
On Error GoTo Hata
Adet = Range("A" & Rows.Count).End(xlUp).Row - 1
Adres = "A2:B" & (Adet + 1)
Range(Adres).Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
Hücre = ActiveCell
Do
ActiveCell.Offset(1, 0).Select
If ActiveCell = Hücre Then
Toplam = Selection.Offset(0, 1) + Toplam
Selection.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Toplam = ActiveCell.Offset(0, 1) + Toplam
ActiveCell.Offset(0, 1) = Toplam
End If
Toplam = 0
Hücre = ActiveCell
Loop Until ActiveCell = Range("A" & Adet + 1)
Exit Sub
Hata:
Err.Clear
End Sub

Hiç yorum yok:

Blog Arşivi

Bu gadget'ta bir hata oluştu

Bu Blogda Ara

Contributor

Contributor
Mustafa ULUSARAÇ İstanbul, TÜRKİYE
free counters
T. C. Central Bank Indicative Exchange Rates
Currency Exchange Rate Widget,Currency Converter Widget
Borsa İstanbul