• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Makro ile pivot tabloya isim verme

  • Konbuyu başlatan Konbuyu başlatan hmtstc
  • Başlangıç tarihi Başlangıç tarihi
H

hmtstc

Katılım
20 Şubat 2014
Mesajlar
315
Excel Vers. ve Dili
Excel 2016 - Türkçe
Merhaba arkadaşlar,

Ben bir işin içinden çıkamadım. Makro kaydet metoduyla bir şeyler hallettim ancak temel bir noktada takıldım.

Yardım edebilecek arkadaşlardan açıklamalı olarak yardım alabilirsem çok mutlu olacağım. Mantığını anlayamadığım için çözemedim.

Açtığım pivot tabloya isim vermek istiyorum. Her zaman aynı isimle oluşturmalı. pivot1 olacak tablonun adı.

Şimdiden çok teşekkür ediyorum.

takıldığım yer burası

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"ODUNC ISCILIK!R1C1:R5000C5000", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="TABLO!R4C1", TableName:="pivot1" _
, DefaultVersion:=xlPivotTableVersion15
Genişletmek için tıkla ...
 
Arkadaşlar tekrar merhaba,

ekteki dosyada amatörce çalışmalar içerisindeyim.
Hat sorumlusu arkadaşlarımız duruşların nedenlerini doğru yazamıyorlar.
Bu nedenle onlara bir iyilik yapmak istiyorum. Olayım şu;

Sheet1 sayfasındaki veriler her zaman değişebilir. sütun olarak sayı değişmez ancak satır olarak değişebilir.
otomatik pivot oluşturmaya çalıştım ama her defasında veri tablosunun satır sayısı farklı olacağı için formülü doğru yazamadım. yazdığım bu formüle göre bir hesaplama da yapıyor.
Oluşan pivot tabloda solda duruş anları yazılı. üstte istasyonlar ve değerler olarak da duruş sürelerini dakika olarak gösteriyor. Ancak aynı anda iki istasyonda durabileceği için pivot tablonun bittiği yerin sağındaki sütununa =MAK formülü ile en yüksek değeri alıyorum. Bu sayıların toplamı vardiyalık duruş süresini gösteriyor.

Devamında bir formül daha var. O da istasyonel bazda bir ayarlama yapıyor. oluşan tabloyu kopyalıyor sonra o tablodaki değerleri tek tek kontrol ederek bulunan =MAK değere eşit olanı hücre eğeri olmayanı 0( sıfır ) olarak gösteriyor. Böylece her istasyonun istasyonel bazda duruşunu da görmüş oluyorum. Ve birazcık süsleme olayı var. Onlar dert değil ama benim asıl takıldığım yer pivot tablo oluşturmak. Çünkü saydıramadım satır sayısını. Bu nedenle rastgele sayı verdim 5000 diye. bu defa (boş) diye birşey çıkıyor benim karşıma. Bütün hesabı değiştiriyor.

Konu ile ilgili yardım edebilirseniz yardım etmeyi fikir verebilirseniz fikir vermeyi esirgemezseniz bende arkadaşlara yardım edeceğim.

Şimdiden çok teşekkürler...

http://s2.dosya.tc/server/gtn7us/Rapor.rar.html
 
Tablo kaynağının büyüklüğünü son değişkenine bağladım. Dolayısıyla boş sütunu kayboldu.
Satırdaki en büyük değer için zaten Özet Tablonun da en Büyük değeri bulma özelliği olduğundan doğrudan o özelliği seçtirdim, buun için ayrıca formül kullanmaya gerek kalmadı.
Kodların son hali aşağıdadır, inceleyin:

Kod: 
Sub Makro1()
[COLOR="Red"][B]son = Sheets("Sheet1").Cells(Rows.Count, "A").End(3).Row[/B][/COLOR]
Sheets.Add
    Sheets(ActiveSheet.Name).Name = ("RAPORLAMA")
'
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
       [COLOR="red"][B] "Sheet1!A1:K" & son[/B][/COLOR], Version:=xlPivotTableVersion10).CreatePivotTable _
        TableDestination:="RAPORLAMA!R3C1", TableName:="PivotTable1", DefaultVersion _
        :=xlPivotTableVersion10
    Sheets("RAPORLAMA").Select
    Cells(3, 1).Select
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("Başlangıç Zamanı")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("İstasyon Adı")
        .Orientation = xlColumnField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable1").PivotFields("İstasyon Adı")
        .PivotItems("356 SIRT OP 1").Visible = False
        .PivotItems("356 SIRT OP 2").Visible = False
        .PivotItems("356 SIRT OP 3").Visible = False
        .PivotItems("OTURAK OP 11 (Oturak Sırt Eşleştirme)").Visible = False
        .PivotItems("OTURAK OP 13").Visible = False
        .PivotItems("OTURAK OP 18 (Em. Kemer Doğrulama)").Visible = False
        .PivotItems("OTURAK OP 30 (Airbag Test)").Visible = False
        .PivotItems("OTURAK OP 31 (Scomparsa Kilit Açma)").Visible = False
        .PivotItems("SIRT OP 1").Visible = False
        .PivotItems("SIRT OP 3").Visible = False
        .PivotItems("SIRT OP 4").Visible = False
    End With
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").PivotFields("Duruş Süresi" & Chr(10) & "(Dakika Olarak)"), _
        "Toplam Duruş Süresi" & Chr(10) & "(Dakika Olarak)", [B][COLOR="red"]xlMax[/COLOR][/B]
    Rows("4:4").RowHeight = 63.75
    Rows("4:4").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("B:D").Select
    Selection.ColumnWidth = 16.14
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Range("B2").Select
    Rows("2:2").RowHeight = 55.5
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "ROBOT DURUŞLARI"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "KILIF VE İSKELET DURUŞLARI"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "EMNİYET KEMERİ TORKLAMA DURUŞLARI"
    Rows("2:2").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Range("B2:D2").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .Color = 65535
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Font.Bold = True
    Columns("F:F").ColumnWidth = 12
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "NET DURUŞ SÜRESİ"
    Range("F4").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 11
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "=RC[-5]"
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "=RC[-5]"
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "=RC[-5]"
    Range("G5").Select
    ActiveCell.FormulaR1C1 = "=RC[-5]"
    Range("G5").Select
    Selection.AutoFill Destination:=Range("G5:I5"), Type:=xlFillDefault
    Range("G5:I5").Select
    Selection.AutoFill Destination:=Range("G5:I56")
    Range("G5:I56").Select
    ActiveWindow.SmallScroll Down:=-6
    Columns("G:I").Select
    Selection.ColumnWidth = 13.29
    Columns("J:J").Select
    Selection.ColumnWidth = 0.92
    Columns("K:M").Select
    Selection.ColumnWidth = 12.86
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 1
    Columns("J:J").ColumnWidth = 16
    Range("J5").Select
    ActiveCell.FormulaR1C1 = "=MAX(RC[-3]:RC[-1])"
    Range("J5").Select
    Selection.AutoFill Destination:=Range("J5:J56")
    Range("J5:J56").Select
    ActiveWindow.SmallScroll Down:=-18
    Range("F4").Select
    Selection.Copy
    Range("J4").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("G4:I4").Select
    Selection.Copy
    Range("K4").Select
    ActiveSheet.Paste
    Range("K5").Select
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "=IF(RC[-4]=RC10,RC[-4],"""")"
    Range("K5").Select
    Selection.AutoFill Destination:=Range("K5:M5"), Type:=xlFillDefault
    Range("K5:M5").Select
    Range("K5:M5").Select
    Selection.AutoFill Destination:=Range("K5:M56")
    Range("K5:M56").Select
    ActiveWindow.SmallScroll Down:=42
    Range("K57:M57").Select
    Selection.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
    Range("K57:M57").Select
    Selection.ClearContents
    Range("F57").Select
    Selection.Copy
    Range("K57:M57").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16776961
        .TintAndShade = 0
    End With
    Selection.Font.Size = 11
    Selection.Font.Size = 12
    Selection.Font.Size = 14
    Range("K58").Select
    ActiveCell.FormulaR1C1 = "ROBOT TAM DURUŞ SÜRESİ"
    Range("L58").Select
    ActiveCell.FormulaR1C1 = "KILIF VE İSKELET TAM DURUŞ SÜRESİ"
    Range("M58").Select
    ActiveCell.FormulaR1C1 = "EMNİYET KEMER TORKLAMA TAM DURUŞ SÜRESİ"
    Range("K59").Select
    Rows("58:58").RowHeight = 43.5
    Rows("58:58").Select
    Range("C58").Activate
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=15
    Selection.RowHeight = 78
    Range("K58:M58").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent4
        .TintAndShade = 0.399975585192419
        .PatternTintAndShade = 0
    End With
    Selection.Font.Bold = True
    Selection.Font.Size = 11
    Range("N58").Select
End Sub
 
ya var ya siz gibi güzel insanlara ne söylesek az... ne söylesek... Allah bu yaptığınız iyilikleri hiç bir zaman karşılıksız bırakmasın inşallah. Yusuf hocam formülü uyguladım aynen oldu. Çok teşekkür ederim...
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst