Calculating Cells

Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Merhaba arkadaşlar,

İçimde makro kayıt ettiğim bir dosyayı açıp kapatırken yada makroyu çalıştırırken hatta başka bir isim ile save ettiğimde bile sol alt köşede "calculating cells" yazıyor ve beni uzunca bir süre bekletiyor. bundan kurtulmamın yolu var mı acaba ?
Kod:
Sub ISA()
     Range("F1").Select
    ActiveCell.FormulaR1C1 = "1"
    Range("F1").Select
    Selection.Copy
    Range("C2:C8850").Select
    Selection.PasteSpecial Paste:=xlAll, Operation:=xlMultiply, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "0"
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("A2").Select
    
    
    
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "tip"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(LEFT(RC[2],3)=""BUR"",""BURLA"",IF(LEFT(RC[2],3)=""GÜL"",""GÜL"",IF(LEFT(RC[2],3)=""ALK"",""ALKANLAR"",IF(LEFT(RC[2],3)=""UZM"",""UZMANLAR"",""AND""))))"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A8850")
    Range("A2:A8850").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        "dbo_OSRAM_TR_ugurgExcelExp!R1C1:R8850C6").CreatePivotTable TableDestination _
        :="", TableName:="PivotTable1"
    ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)
    ActiveSheet.Cells(3, 1).Select
    ActiveSheet.PivotTables("PivotTable1").SmallGrid = False
    ActiveSheet.PivotTables("PivotTable1").AddFields RowFields:="Article", _
        ColumnFields:="tip"
    ActiveSheet.PivotTables("PivotTable1").PivotFields("qtyCurPer").Orientation = _
        xlDataField
    Application.CommandBars("PivotTable").Visible = False
    ActiveWindow.SmallScroll Down:=-13
    Range("B5").Select
    ActiveWindow.FreezePanes = True
    Range("B3").Select
MsgBox "İŞLEM BİRKAÇ DAKİKA SÜREBİLİR KADAR BEKLEYİN"

Range("B4:F4").Select
    ActiveSheet.PivotTables("PivotTable1").PivotSelect "ALKANLAR", xlDataAndLabel
    Range("B4:F4").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("C1").Select
    ActiveSheet.Paste
    Range("C4").Select
    Application.CutCopyMode = False
    Selection.FormulaArray = _
        "=SUM(((RC[-1]=dbo_OSRAM_TR_ugurgExcelExp!R[-2]C[1]:R[8846]C[1])*(Sheet1!R[-3]C=dbo_OSRAM_TR_ugurgExcelExp!R[-2]C[-2]:R[8846]C[-2])*(dbo_OSRAM_TR_ugurgExcelExp!R[-2]C[3]:R[8846]C[3])))"
    Selection.FormulaArray = _
        "=SUM(((RC2=dbo_OSRAM_TR_ugurgExcelExp!R2C4:R8850C4)*(Sheet1!R1C=dbo_OSRAM_TR_ugurgExcelExp!R2C1:R8850C1)*(dbo_OSRAM_TR_ugurgExcelExp!R2C6:R8850C6)))"
    Selection.Copy
    Range("D4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("C4").Select
    Selection.Copy
    Range("C5").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("D4").Select
    Selection.Copy
    Range("E4:G4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("C4:G4").Select
    Selection.Copy
    Range("C5:C10").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("C10:G10").Select
    Selection.Copy
    Range("C11:C1597").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("C4").Select

    Columns("C:G").Select
    Selection.Style = "Comma"
    Range("C4").Select

Cells.Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveWindow.SmallScroll Down:=-14
    Range("C4:G1597").Select
    ActiveWindow.SmallScroll Down:=-1
    Selection.Locked = True
    Selection.FormulaHidden = True
    Range("C2").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("C5").Select

KORKAKLAR.Show
MsgBox "İŞLEM TAMAM"
End Sub
 
Üst