Koşullu satır gizleme için makro.

K

KARTAL06

Katılım
22 Kasım 2005
Mesajlar
174
Ekteki örnekte AL sütununda ilk sıfır değerini gördüğü satırda dahil olmak üzere aşağıya doğru 3000 satırı gizletmek mümkünmü? Bu hücrelerdeki değerler fomülle elde ediliyor (örnek formülsüz kopyalanmıştır)makroda bir sorun çıkarırmı?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,603
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Aşağıdaki kodu denermisiniz. Eğer dosyanızdaki formüller problem yaratırsa kodda tek tırnek işareti ile pasif hale getirdiğim satırları aktif hale getirip (tek tırnak işaretini silerek) tekrar deneyiniz.

Kod: 
Sub GİZLE()
    'Application.Calculation = xlCalculationManual
    SIFIR_BUL = [AI:AI].Find(0, LookAt:=xlWhole).Row
    Range("A" & SIFIR_BUL & ":IV" & SIFIR_BUL + 3000).EntireRow.Hidden = True
    'Application.Calculation = xlCalculationAutomatic
End Sub
 
K

kelkitli

Katılım
23 Şubat 2007
Mesajlar
1,212
Excel Vers. ve Dili
Excel2003
Değerli Dostlar Merhabalar,
Benim de konuyla ilgili şöyle bir problemim var. A sütununda A5 hücresinden sonra (A5 herhangi bir ayın misal 01.01.2007 gibi ilk gününü yazınca ayın son gününe kadar işleniyor) en son dolu satırı bulup ondan sonraki 3 satırı gizlemem gerekiyor. Ancak makro tekrar çalıştığında bu 3 satırı tekrar işleme koyabilmeli. Yani her seferinde görünmeyen satırlara yeni satırlar ekleyerek gizlenen satırları artırmamalı.
 
Son düzenleme:
K

KARTAL06

Katılım
22 Kasım 2005
Mesajlar
174
Her iki şelikdede çalışmadı.

COST_CONTROL' Alıntı:
Selamlar,

Aşağıdaki kodu denermisiniz. Eğer dosyanızdaki formüller problem yaratırsa kodda tek tırnek işareti ile pasif hale getirdiğim satırları aktif hale getirip (tek tırnak işaretini silerek) tekrar deneyiniz.

Kod: 
Sub GİZLE()
    'Application.Calculation = xlCalculationManual
    SIFIR_BUL = [AI:AI].Find(0, LookAt:=xlWhole).Row
    Range("A" & SIFIR_BUL & ":IV" & SIFIR_BUL + 3000).EntireRow.Hidden = True
    'Application.Calculation = xlCalculationAutomatic
End Sub
Genişletmek için tıkla ...
İlginize teşekkürler ama çalıştıramadım.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,603
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

İlgili sayfanızda bir buton oluşturup kodları butona atayın.
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,603
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Uyguladığınız dosyayı eklermisiniz. Eğer dosya boyutu büyükse küçülterek eklemeye çalışın.
 
K

KARTAL06

Katılım
22 Kasım 2005
Mesajlar
174
Uyguladığım dosyada başka bir makro daha var.

Kod en başta eklediğim soru adlı dosyada çalıştı. Ama çalıştırmam gereken dosyada hem başka bir makro var hemde başka sayfalardan formülle veri alıyor. Hata bundan kaynaklanıyor olabilirmi?
 
Korhan Ayhan

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,603
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Dosyanızı görmeden hatanın nerden kaynaklandığını bilemeyiz.
 
K

KARTAL06

Katılım
22 Kasım 2005
Mesajlar
174
Dosya cok geniş.

Verdiği hatayı yazıyorum "object variable or wiht block veriable not set".
Kod sade bir sayfada çalışıyor. Yada bu kodu benim kullandığın makroya ekleyebilirmiyiz.
Sub RAPORKOPYALAMA()
'
' RAPORKOPYALAMA Makro
' Makro Users tarafından 21.07.2007 tarihinde kaydedildi.
'

'
Workbooks.Add
Sheets("Sayfa1").Select
Sheets("Sayfa1").Name = "SİPARİŞ"
Windows("KOTROL RAPORU TEMEL DENEME.xls").Activate
Cells.Select
Selection.Copy
Windows("Kitap1").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("Q:AI").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("A1:E4").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Windows("KOTROL RAPORU TEMEL DENEME.xls").Activate
Range("A1:E4").Select
Sheets("UYARI").Select
ActiveSheet.Shapes("WordArt 1").Select
Selection.Copy
Windows("Kitap1").Activate
Range("F16").Select
ActiveSheet.Paste
Sheets("SİPARİŞ").Select
Sheets.Add
Sheets("Sayfa2").Select
Sheets("Sayfa2").Move After:=Sheets(2)
Sheets("Sayfa2").Select
Sheets("Sayfa2").Name = "ET"
Range("A1").Select
Windows("KOTROL RAPORU TEMEL DENEME.xls").Activate
Sheets("RAPOR ET").Select
Cells.Select
Selection.Copy
Windows("Kitap1").Activate
Cells.Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("Q:AI").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("R13").Select
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.196850393700787)
.BottomMargin = Application.InchesToPoints(0.196850393700787)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
End With
Windows("KOTROL RAPORU TEMEL DENEME.xls").Activate
Range("A1:E4").Select
Sheets("UYARI").Select
Selection.Copy
Windows("Kitap1").Activate
Range("E17").Select
ActiveSheet.Paste
Windows("KOTROL RAPORU TEMEL DENEME.xls").Activate
Sheets("RAPOR SİPARİŞ").Select
Range("N6:p6").Select
Windows("Kitap1").Activate
Sheets("SİPARİŞ").Select
Range("N6:p6").Select
ActiveCell.FormulaR1C1 = "YLS 07 -16"
With ActiveCell.Characters(Start:=1, Length:=10).Font
.Name = "Arial Tur"
.FontStyle = "Kalın"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Range("A1:E4").Select
ChDir "D:\NEUSON RAF\KONTROL RAPORLARI 2007"
ActiveWorkbook.SaveAs Filename:= _
"D:\NEUSON RAF\KONTROL RAPORLARI 2007\YLS 07 -16.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst