- Katılım
- 2 Şubat 2007
- Mesajlar
- 194
- Excel Vers. ve Dili
- Office 2007 Tr
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub SATIR_EKLE_TOPLAM_AL()
Dim X As Long, ALAN As Range
Application.ScreenUpdating = False
For X = [A65536].End(3).Row To 2 Step -1
If Mid(Cells(X, 1), 1, 3) <> Mid(Cells(X - 1, 1), 1, 3) Then
Rows(X).Insert
Cells(X, 1) = Mid(Cells(X + 1, 1), 1, 3)
Cells(X, 1).Font.Bold = True
Cells(X, 2).Font.Bold = True
End If
Next
For X = 2 To [A65536].End(3).Row
If Cells(X, 1).Font.Bold = False Then Cells(X, 3) = "X"
Next
For Each ALAN In Columns("C:C").SpecialCells(xlCellTypeConstants, 2).Areas
ALAN.Resize(1).Offset(-1, -1) = WorksheetFunction.Sum(ALAN.Offset(0, -1))
Next
[C:C].ClearContents
Application.ScreenUpdating = True
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub