• DİKKAT

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

gizle yazan gizlensin

ikikan

ikikan

Katılım
3 Mart 2009
Mesajlar
519
Excel Vers. ve Dili
excel 2003 tr
Sub gizle()
For i = 6 To 1000
Range("b" & i).Select
If ActiveCell.Value = "Gizle" Then
Selection.EntireRow.Hidden = True
Else
Selection.EntireRow.Hidden = False
End If
Next
End Sub

bu kod işe yarıyor ama cok yavaş 1 ile 10 satırda sorun yok ama 1 .ile 1000 arasında sorun yaşıyor
daha hizlı olabilirmi ayrıca göster secenegide eklene bilirimi şimdiden teşekürler
 
ikikan' Alıntı:
Sub gizle()
For i = 6 To 1000
Range("b" & i).Select
If ActiveCell.Value = "Gizle" Then
Selection.EntireRow.Hidden = True
Else
Selection.EntireRow.Hidden = False
End If
Next
End Sub

bu kod işe yarıyor ama cok yavaş 1 ile 10 satırda sorun yok ama 1 .ile 1000 arasında sorun yaşıyor
daha hizlı olabilirmi ayrıca göster secenegide eklene bilirimi şimdiden teşekürler
Genişletmek için tıkla ...

örnek bir dosya eklerseniz, daha hızlı cevap alabilirsiniz
 
Aşağıdaki kodu denermisiniz
Kod: 
Sub gizle()
For i = 6 To 1000
If Range("b" & i) = "Gizle" Then
Range("b" & i).EntireRow.Hidden = True
End If
Next i
End Sub
 
Kod: 
Sub göster()
For i = 6 To 1000
If Range("b" & i) = "Gizle" Then
Range("b" & i).EntireRow.Hidden = False
End If
Next i
End Sub
 
kuvari' Alıntı:
Aşağıdaki kodu denermisiniz
Kod: 
Sub gizle()
For i = 6 To 1000
If Range("b" & i) = "Gizle" Then
Range("b" & i).EntireRow.Hidden = True
End If
Next i
End Sub
Genişletmek için tıkla ...


evet denedim işe yaradı daha hızlandı ancak yapmak istedigi
bu kodu hızlı halle getirmek mümkünmü bunu çözdk

ama göster seçenegi eklemek ve sayfa kaydı edildiginde otamatik olarak makro çalışır hale getirile bilirmi düğmesiz olacak
 
ikikan' Alıntı:
evet denedim işe yaradı daha hızlandı ancak yapmak istedigi
bu kodu hızlı halle getirmek mümkünmü bunu çözdk

ama göster seçenegi eklemek ve sayfa kaydı edildiginde otamatik olarak makro çalışır hale getirile bilirmi düğmesiz olacak
Genişletmek için tıkla ...



kayıt eklemek nasıl olacak,onları anlamak açısından örnek bir dosya eklerseniz

daha hızlı cevap alabilirsiniz
 
Merhaba,
Kalabalık satırları daha hızlı gizlemek için alternatif olarak aşağıdaki kod kullanabilirsiniz.
Kod: 
Sub gizle()
Set Aralik = Range("b6:b" & [b65536].End(3).Row)
    Set Bul = Aralik.Find("Gizle", LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    Application.ScreenUpdating = False
        Adres = Bul.Address
        Do
        Bul.EntireRow.Hidden = True
        Set Bul = Aralik.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    MsgBox "İşlem tamam.", vbInformation, "leumruk"
    End If
End Sub
Diğer isteğinizi biraz daha açıklayabilirseniz yardımcı olamaya çalışayım.
 
Sub gizle()
For i = 6 To 1000
If Range("b" & i) = "Gizle" Then
Range("b" & i).EntireRow.Hidden = True
End If
Next i
End Sub
 
Merhaba,
Aşağıdaki kodu "Thisworkbook" bölümüne kopyalayın. Dosyayı kaydettiğinizde kodlar çalışır.
Kod: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Columns(2).EntireRow.Hidden = False
Set Aralik = Range("b6:b" & [b65536].End(3).Row)
    Set Bul = Aralik.Find("Gizle", LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    Application.ScreenUpdating = False
        Adres = Bul.Address
        Do
        Bul.EntireRow.Hidden = True
        Set Bul = Aralik.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    MsgBox "İşlem tamam.", vbInformation, "leumruk"
    End If
End Sub
 
leumruk' Alıntı:
Merhaba,
Aşağıdaki kodu "Thisworkbook" bölümüne kopyalayın. Dosyayı kaydettiğinizde kodlar çalışır.
Kod: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Columns(2).EntireRow.Hidden = False
Set Aralik = Range("b6:b" & [b65536].End(3).Row)
    Set Bul = Aralik.Find("Gizle", LookAt:=xlWhole)
    If Not Bul Is Nothing Then
    Application.ScreenUpdating = False
        Adres = Bul.Address
        Do
        Bul.EntireRow.Hidden = True
        Set Bul = Aralik.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    MsgBox "İşlem tamam.", vbInformation, "leumruk"
    End If
End Sub
Genişletmek için tıkla ...
kod çalışmadı aşagıdaki kod çalışıyor ama cok yaş hızlandıra bilirsek işimeyarar

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
For i = 6 To 1000
If Range("b" & i) = "Gizle" Then
Range("b" & i).EntireRow.Hidden = True
Else
Range("b" & i).EntireRow.Hidden = False
End If
Next i
End Sub

ayrıca yapmak istedigimle ilgili bir dosya gönderiyorum yardımlarınız için şimdiden teşekürler
 

Ekli dosyalar

Merhaba,
Kodu aşağıdaki şekliyle deneyin.
Kod: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Columns(2).EntireRow.Hidden = False
Set Aralik = Range("b6:b" & [b65536].End(3).Row)
    Set Bul = Aralik.Find("Gizle", LookIn:=xlValues, lookat:=xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
        Set Bul = Aralik.FindNext(Bul)
        Bul.EntireRow.Hidden = True
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    MsgBox "İşlem tamam.", vbInformation, "leumruk"
    End If
End Sub
 
leumruk' Alıntı:
Merhaba,
Kodu aşağıdaki şekliyle deneyin.
Kod: 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.ScreenUpdating = False
Columns(2).EntireRow.Hidden = False
Set Aralik = Range("b6:b" & [b65536].End(3).Row)
    Set Bul = Aralik.Find("Gizle", LookIn:=xlValues, lookat:=xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
        Set Bul = Aralik.FindNext(Bul)
        Bul.EntireRow.Hidden = True
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    MsgBox "İşlem tamam.", vbInformation, "leumruk"
    End If
End Sub
Genişletmek için tıkla ...

teşekür ederim bu kod işe yaradı sağolun........
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst