• DİKKAT

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

Harekete ve sayfa girişine göre I sütunu kolon genişliği..!

Katılım
10 Ekim 2010
Mesajlar
1,469
Excel Vers. ve Dili
2010 Türkçe
Merhaba,
Sayfaya her girişte ve sayfada her harekette I sütununda bulunan veriye göre kolon genişliğini ayarlaması gerekiyor. Aşağıdaki kodlarla bunu yapamıyorum ne gibi değişiklikler olması gerekiyor.
Yardımcı olabilir misiniz?


Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    Columns("I:I").EntireColumn.AutoFit
End Sub


Kod:
Private Sub Worksheet_Activate()
    Columns("I:I").EntireColumn.AutoFit
End Sub
 
...Sayfaya her girişte ve sayfada her harekette I sütununda bulunan veriye göre kolon genişliğini ayarlaması gerekiyor...

Merhaba,
"harekette" kavramından kastınız bir hücreden başka bir hücreye geçmek/başka bir hücreyi seçmek ise bu durumda koddaki
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
satırını
Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ile değiştirmeniz gerekir.
 
Teşekkür ederim Sayın dede, istediğim gibi oldu.
Aynı zaman da ko hakkında bilgimde oldu.
 
Merhaba, Günaydın Dede,
Bu kodlar randımanlı çalışmıyor. I3:I aralığında formüllerle gelen veri var. Verilere göre kolon genişliğini ayarlamıyor. Ben I3:I aralığında işlem yapmıyorum. Farklı sütunda yapıyorum. Sonuçlar formüllerle I3:I aralığına geldiğinden bu sütunun içeriğine göre kolon genişlikleri ayarlaması gerekiyor.
 
...Bu kodlar randımanlı çalışmıyor. I3:I aralığında formüllerle gelen veri var. Verilere göre kolon genişliğini ayarlamıyor. Ben I3:I aralığında işlem yapmıyorum. Farklı sütunda yapıyorum. Sonuçlar formüllerle I3:I aralığına geldiğinden bu sütunun içeriğine göre kolon genişlikleri ayarlaması gerekiyor.

Merhaba,
Yukarıdaki kod, sonuçlar formüllerle I3:I aralığına geldiğinde bu sütunun içeriğine göre kolon genişlikleri ayarlıyor. Eğer yapmıyorsa dosyanızda bulunan diğer kodlardan etkileniyor olabilir.
Örnek dosyanızı eklerseniz yardımcı olmaya çalışırım.
 
Merhaba Sayın Dede,
Çalışma sayfasının C3:C aralığından isim seçerek I3:I sütunu gözlemleyebiliriz.
Sayfada bulunan diğer kodlar ise Çalışmanın kod kısmında belirlenmiştir.
Örnek çalışma aşağıdaki linktedir. Şirkette olduğumdan ancak bu şekilde upload edebiliyorum.
Teşekkür ediyorum ilginiz için. Çok sağ olun.
İyi çalışmalar dilerim.


http://www.dosya.tc/server/kI4zPr/_rnek.rar.html
 
Merhaba,
Dosyanızda bulunan (daha doğrusu bulunmayan) satır nedeniyle bu sonucu alıyorsunuz.
Sorun Private Sub Worksheet_Activate() prosedüründe bulunan Application.EnableEvents = False olayını aynı prosedürün son satırından önce Application.EnableEvents = True olarak yenilememenizden kaynaklanıyor.
Bu düzelmeyi yapınca Private Sub Worksheet_SelectionChange(ByVal Target As Range) prosedürüne gerek kalmamaktadır. Tüm kodu aşağıdaki ile değiştirmeniz yeterli olacaktır.
Eklediğim satırları kırmızı olarak belirttim.
Hoşçakalın.

Kod:
Private Sub Worksheet_Activate()
'Sayfaya her girişte formülleri yeniler
Application.EnableEvents = False
    Range("F3:H" & Rows.Count).ClearContents
    Son = Cells(Rows.Count, 2).End(3).Row + 1
    With Range("F3:F" & Son)
        .Formula = "=IF(B3<>"""",SUMIF(STOK!A:A,B3,STOK!E:E),"""")"
        .Value = .Value
    End With
    With Range("G3:G" & Son)
        .Formula = "=IF(B3<>"""",SUMIF(GELENLER!A:A,B3,GELENLER!C:C),"""")"
        .Value = .Value
    End With
    With Range("H3:H" & Son)
        .Formula = "=IF(AND(F3<>"""",F3=G3),"" Üretim Tamamlanmıştır."",IF(G3<F3,TEXT(F3-G3,""#.##0,0"")&"" MT Üretim Olmuştur."",IF(G3>F3,TEXT(G3-F3,""#.##0,0"")&"" MT Sevk Edilmiş Kumaş Vardır."",IF(AND(F3="""",G3=""""),"""",""?""))))"
        .Value = .Value
    End With
    'Sayfayı en üste getirir
    ActiveWindow.ScrollRow = 1
[COLOR="red"]Application.EnableEvents = True[/COLOR]
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="Red"]Columns("I:I").EntireColumn.AutoFit[/COLOR]
'B sütuna veri girildiğinde A sütunda tarih yazar
On Error GoTo Son
If Intersect(Target, [B:B]) Is Nothing Then Exit Sub
If Target.Row < 3 Then Exit Sub
If Target <> "" Then Target.Offset(0, -1) = Date
If WorksheetFunction.CountA(Target) = 0 Then Target.Offset(0, -1).Clear
Son:
'Veri girildiğinde formülleri gösterir
If Intersect(Target, Range("B3:B" & Rows.Count)) Is Nothing Then Exit Sub
    On Error Resume Next
    Application.EnableEvents = False
    Range("F3:H" & Rows.Count).ClearContents
    Son = Cells(Rows.Count, 2).End(3).Row + 1
    With Range("F3:F" & Son)
        .Formula = "=IF(B3<>"""",SUMIF(STOK!A:A,B3,STOK!E:E),"""")"
        .Value = .Value
    End With
    With Range("G3:G" & Son)
        .Formula = "=IF(B3<>"""",SUMIF(GELENLER!A:A,B3,GELENLER!C:C),"""")"
        .Value = .Value
    End With
    With Range("H3:H" & Son)
        .Formula = "=IF(AND(F3<>"""",F3=G3),"" Üretim Tamamlanmıştır."",IF(G3<F3,TEXT(F3-G3,""#.##0,0"")&"" MT Üretim Olmuştur."",IF(G3>F3,TEXT(G3-F3,""#.##0,0"")&"" MT Sevk Edilmiş Kumaş Vardır."",IF(AND(F3="""",G3=""""),"""",""?""))))"
        .Value = .Value
    End With
    Application.EnableEvents = True
End Sub

NOT: İlk mesaja dosya eklememenin sonucu birkaç kez mesajlaşma, forumda kirlilik, zaman ve emek kaybı. Yanılıyor muyum?
 
Son düzenleme:
Hocam aşağıdaki formülü, koda çevirip, yukarıda son yazdığınız kodların arasına ekleyebilir misiniz. ben makro kaydet ile yapmaya çalıştım sonuç olumsuz, bazı yöntemlerle sonuç aldım bu kezde excel hata verşp donuyor daha sonrada kapanıyor.

Kod:
=EĞER(EHATALIYSA(DÜŞEYARA($C3;ŞARTLAR!$B$3:$C$65536;2;0));"";DÜŞEYARA($C3;ŞARTLAR!$B$3:$C$65536;2;0))
 
Merhaba,
Formül C sütununda hangi satırlara bakacak? Göründüğü kadarıyla sadece C3 değil.
Sonuçlar hangi hücrelere yazılacak?
" ...kodların arasına ekleyebilir misiniz..." Hangi prosedürde kodların neresine eklenecek?

Özet: Förmülü Örnek Dosyada görmek lazım.
 
Merhaba hocam,
Girişleri C3:C sütunda olacak, sonuçları yani formülün uygulandığı hücre I3:I
Örneğin C15 deki verinin sonucu I15de olmalı
Umarım anlatabildim.
 
Formül Şartlar sayfasından B3:B bakacak veriler eşitse, Şartlar sayfasının C3:C veriyi I3:I getirecek
 
Merhaba Hocam,
Örnek dosya aşağıdaki linkte olup, I3:I aralığında formül bulunmakta. Sayfada formül istemediğim için, formülü makroya çevirip, C3:C aralığında ki isme göre sonuç vermesini istiyorum.
Örnek dosyayı incelediğinizde eminim anlamış olursunuz.


http://s2.dosya.tc/server/Pnp2GM/deneme.rar.html
 
Merhaba,
Mevcut kodunuzda aşağıdaki satırların arasına kırmızı ile belirttiğim satırları ekleyip dener misiniz?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="Red"]If Not Intersect(Target, Range("I3:I" & Rows.Count)) Is Nothing Then GoTo Atla
If Intersect(Target, Range("C3:C" & Rows.Count)) Is Nothing Then GoTo Atla
On Error GoTo Atla
Set s2 = Sheets("ŞARTLAR")
ss2 = s2.Range("C" & Rows.Count).End(3).Row
    Cells(Target.Row, 9).Value = WorksheetFunction.VLookup(Target, s2.Range("B3:C" & ss2), 2, 0)
Atla:[/COLOR]
Columns("I:I").EntireColumn.AutoFit
 
Hocam Merhaba,
Elinize sağlık on numara olmuş, belirtmediğim minik bir sorun var yalnız. C3:C müşteri ismine delete ile sildiğimde I3:I bulunan not kalıcı oluyor. Onunda silinmesi gerekiyor. Bu şekilde uyarlayabilir miyiz?
 
Merhaba,
Mevcut kodunuzda aşağıdaki satırların altına kırmızı satırı ekleyerek dener misiniz?
Kod:
On Error GoTo Atla
[COLOR="Red"]If Target = "" Then Cells(Target.Row, "I").Value = ""[/COLOR]
 
Hocam eyvallah, Çok teşekkür ediyorum.
Elinize Sağlık.
 
Geri
Üst