- 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 ?
İç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