Koşullu süz yer değiştir ve yazdır

noxious · 13 Kasım 2007

UserForm1 açıldığında
TextBox1 içerisine Görevli ismini yazdığımda AA, AB, AC, AD sütunları taranıyor ve bulunan Görevlilerin isimleri yan yana her bulunduğu satır bir altta olmak üzere ListBox2 üzerinde sıralanıyor.

Ben ise sıralama yapıldıktan sonra ListBox2 üzerinde birinci sıraya A Hücresindeki satır numarası, 2. sıraya AA, 3. sıraya AB, 4. sıraya AC, 5. sıraya AD hücre bilgisi ve 6. B, 7. C, 8. D, ……………. Olmak üzere 26. Hücreye Z hücresinin bilgisinin gelmesini istiyorum.

Yani AA, AB, AC, AD hücre bilgileri sıralamada yer değiştirerek ListBox2 içerisinde 2. sıradan itibaren başlayacak ve sonra diğer hücreler devam edecek. Bu arada ListBox2 üzerinde A1’den AD1 e kadar olan hücrelerin isimleri yazacak. Bu arada UserForm dan çıkınca sayfa üzerindeki bilgiler süz işleminden önceki ilk hallerini koruyacak yani sayfada bir değişiklik olmayacak

Mümkünse bu arada UserForm1 çalıştığında aşağıdaki işlem yapılmadan önce TextBox1 içerisi boş olacağından ilk başta ListBox2’nin yukarıdaki sıralamaya göre dolması, ve TextBox1 içerisine isim yazdıkça döngünün başlaması, bu işlem çok kasacaksa gerekli değil çünkü veri miktarı çok fazla olacak

TextBox2 içerisine AA, AB, AC, AD hücrelerinde aratma yaptığımız isimden kaç adet çıktı ise o kadar sayının görünmesini gerekiyor. ( başka kodlarla başka formlarda yaptım ama ekte örneği bulunan kod'a uyarlayamadım

)

Son olarak mümkünse Yazdır komutu
Eğer yazdır komutu verirsek ListBox2 içerisinde sıralanan listede süz yaptığımızda kalan verilere göre AA, AB, AC, AD hücrelerinden başlamak üzere B, E, I ve J hücrelerini seçerek yazdırma işlemi gerçekleşecek

Çok şey istiyorum ama benim için hayati önem arz ediyor.

Ustalarıma ve Hocalarıma saygılarımla

noxious · 13 Kasım 2007

Macro ile tüm bilgileri aktar ve yaz işlemini hallettim ama bana süzden sonra kalan bilgilerin aktarılarak yazdırma işlemininde yapılması lazım

Ayrıca Seçmeli Tümünü yazdır işleminde

Kod:

Private Sub CommandButton1_Click()
    Sheets("Yazd&#305;r").Select
    Range("B2:I65500").Select
    Selection.ClearContents
    Sheets("Denetlemeler").Select
    Range("AA2:AD65500").Select
    Selection.Copy
    Sheets("Yazd&#305;r").Select
    Range("B2").Select
    ActiveSheet.Paste
    Sheets("Denetlemeler").Select
    Range("B2:B65500").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Yazd&#305;r").Select
    Range("F2").Select
    ActiveSheet.Paste
    Sheets("Denetlemeler").Select
    Range("E2:E65500").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Yazd&#305;r").Select
    Range("G2").Select
    ActiveSheet.Paste
    Sheets("Denetlemeler").Select
    Range("I2:J65500").Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Yazd&#305;r").Select
    Range("H2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
    Range("B2:I65500").Select
    Selection.ClearContents
    Sheets("Denetlemeler").Select
    End Sub

Bu kodları kısaltabilirmiyiz

noxious · 14 Kasım 2007

Ustalarıma, Hocalarıma ve yardımcı olmaya çalışan arkadaşlara saygılarımla

122 izleme ve 22 yükleme yapılmış (son güncelleme 16.11.2007 saat:17.45), acaba bu arkadaşlardan birisinin bu konuda yardımı dokunabilecekmi, sorduğum soruların yapılabilirliği varmıdır, biraz fazla şey istedim artık kusura bakmayın.

noxious · 15 Kasım 2007

Ustalarım, Hocalarım

Hiç cevap yok en azından mümkün olup olmadığı konusunda bilgi verirseniz olamayacaksa umudumu keseyim.

Saygılarımla

noxious · 15 Kasım 2007

Güncelleme

NEDEN CEVAP GELMİYOR

En azından arkadaşım sen bu rüyadan vazgeç deyin

İkinci mesajımda bulunan reyting i cevap gelene kadar devamlı güncelleyeceğim

noxious · 17 Kasım 2007

Arkadaşlar 1. mesajımdaki sorularım ile ilgili hazırlanacak macro nun kimsenin işine yaramayacağı ve bundan dolayı ne cevap verildiği nede macronun hazırlanması konusunda yardım edilmeyeceği kanısına kapıldım. Eğerki bir gün biri bir iyilik yapmak isterde zaman ayırma imkanı bulursa rica etsem bana özelden haber verebilirmi. Kardeşim sorununu çözdük diye. Benden hayır duası alır çözen arkadaş. 3. mesajımda reytingi takip ediyordum ama ondanda vaz geçtim. Yaw arkadaş en azından olmaz diye cevap yazın, valla cevap gelmiyor diye moralim bozuldu

Tüm Hocalarıma, Uzmanlara saygılarımla. Ben basit ve kolay macrolar ile yoluma devam edeyim bari

mesuttasar · 17 Kasım 2007

Bence sakin olmalısın mutlaka gözden kaçmıştır yoksa çok daha kısa süre içerisinde arkadaşlar sana yardım ederlerdi bundan şüphen olmasın. Arzu edersen dikkat çekmek için üstatlardan birine bu sayfanın adresi ile ilgili bir özel mesaj gönder faydası olur kanaatindeyim.

Umutsuzluğa kapılma

Ferhat Pazarçevirdi · 17 Kasım 2007

Merhabalar

Yazdıklarınızdan, problemin bir kısmını hallettiğinizi anlıyorum. Dosyanızın son halini ve son olarak ne istediğinizi ekler misiniz?

noxious · 17 Kasım 2007

Teşekkürler

Sayın FPC Hocam ilgi için teşekkürler.

Umudumu kesmiştim Allah razı olsun. Birinci mesajımda güncellenmiş yazdır komutlu hali var

2. mesajımdaki kodlarla tümünü yazdır dediğimde aşağıda istediğim yer değişikliğini yaparak tüm kayıtları yazıcıdan çıktı alabiliyorum. Kodlar biraz uzun oldu ama işimi görüyor.

Ben UserForm konusunda sorun yaşıyorum
UserForm1 açıldığında
TextBox1 içerisine Görevli ismini yazdığımda AA, AB, AC, AD sütunları taranıyor ve bulunan Görevlilerin isimleri yan yana her bulunduğu satır bir altta olmak üzere ListBox2 üzerinde sıralanıyor.

Ben ise sıralama yapıldıktan sonra ListBox2 üzerinde birinci sıraya A Hücresindeki satır numarası, 2. sıraya AA, 3. sıraya AB, 4. sıraya AC, 5. sıraya AD hücre bilgisi ve 6. B, 7. C, 8. D, ……………. Olmak üzere 26. Hücreye Z hücresinin bilgisinin gelmesini istiyorum. sıralama Yazdır komutunda olduğu gibi başlayacak ve 26. hücreye kadar içerisine alacak.

Yani AA, AB, AC, AD hücre bilgileri sıralamada yer değiştirerek ListBox2 içerisinde 2. sıradan itibaren başlayacak ve sonra diğer hücreler devam edecek. Bu arada ListBox2 üzerinde (sıralama yapıldıktan sonraki son halinin) A1’den AD1 e kadar olan hücrelerin isimleri yazacak. (UserForm dan çıkınca sayfa üzerindeki bilgiler süz işleminden önceki ilk hallerini koruyacak yani sayfada bir değişiklik olmayacak)

TextBox2 içerisine AA, AB, AC, AD hücrelerinde aratma yaptığımız isimden kaç adet çıktı ise o kadar sayının görünmesi gerekiyor.

Yazdır komutu
Yazdır komutu verdiğimizde ListBox2 içerisinde sıralanan listede süz yaptığımızda kalan verilere göre AA, AB, AC, AD hücrelerinden başlamak üzere B, E, I ve J hücrelerini seçerek yazdırma işlemi gerçekleşecek

Ferhat Pazarçevirdi · 17 Kasım 2007

Şu an dosyanızda bulunan Textbox1'in Change olay kodunu aşağıdaki ile değiştiriniz.

Kod:

Private Sub TextBox1_Change()
Dim sh As Worksheet
Dim bul As Range, rg As Range
Dim y As Integer, satir As Integer, x As Integer
Dim i As Integer, j As Integer
Dim arrSatir()
Dim arrveri()
Dim adres As String
If Trim(TextBox1) = Empty Then: ListBox2.Clear: TextBox2 = Empty: Exit Sub
Set sh = Sheets("Denetlemeler")
Set rg = sh.Range("AA1:AD65536")
Set bul = rg.Find(What:=TextBox1, Lookat:=xlPart)
ListBox2.Clear
[COLOR=green]'ListBox2.ColumnWidths = "20;100;100;100;100;100;100;100;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20"[/COLOR]
TextBox2 = Empty
ListBox2.ColumnCount = 30
If Not bul Is Nothing Then
   adres = bul.Address
   Do
      If bul.Row = satir Or bul.Row = 1 Then: GoTo f1
      satir = bul.Row
      ReDim Preserve arrSatir(x)
      arrSatir(x) = bul.Row
      x = x + 1
f1:
      Set bul = rg.FindNext(bul)
   Loop While Not bul Is Nothing And bul.Address <> adres
End If
ReDim Preserve arrveri(UBound(arrSatir), 1)
For i = 0 To UBound(arrSatir)
    arrveri(i, 1) = sh.Cells(arrSatir(i), 1)
Next i
ReDim Preserve arrveri(UBound(arrSatir), 5)
For i = 0 To UBound(arrSatir)
    For j = 2 To 5
        arrveri(i, j) = sh.Cells(arrSatir(i), j + 25)
    Next j
Next i
ReDim Preserve arrveri(UBound(arrSatir), 30)
For i = 0 To UBound(arrSatir)
    For j = 6 To 30
        arrveri(i, j) = sh.Cells(arrSatir(i), j - 4)
    Next j
Next i
ListBox2.List = arrveri
TextBox2 = ListBox2.ListCount
End Sub

noxious · 17 Kasım 2007

Sayın FPC Hocam harikasınız Allah razı olsun

Süz işlemi için TextBox1 içerisine Listedeki isimleri yazınca sorun yok ama olmayan bir ismi girdiğimizde hata veriyor

Sıralama tam istediğim gibi
Ancak ListBox2 içerisinde sıralama değiştiği için sıralanan konuların ne olduğunu anlamak açısından Sıra, Görevli1, Görevli2 ............ M, N, O, P yazılarının başlık olarak 1. satırda sabit kalarak görünmesi lazımki yapılan işlemin ne olduğunu görelim

Son olarak yaptığımız sıralamayı nasıl yazdırabiliriz
Yazdır komutu
Yazdır komutu verdiğimizde ListBox2 içerisinde sıralanan listede süz yaptığımızda görüntülenen verilere göre AA, AB, AC, AD, B, E, I ve J hücrelerini seçerek yazdırma işlemi gerçekleşecek (I Sütunu tarih sütunu olduğundan tarih sırasına göre sıralanması lazım eski tarihten yeni tarihe doğru)

İlgi alaka ve yardımlarınız için tekrar Allah razı olsun

Ferhat Pazarçevirdi · 17 Kasım 2007

Peki, o zaman, mevcut projedeki tüm kodları silip yerine aşağıdakileri kopyalayınız.

Kod:

Option Explicit
Private Sub TextBox1_Change()
Dim sh As Worksheet
Dim bul As Range, rg As Range
Dim y As Integer, satir As Integer, x As Integer
Dim i As Integer, j As Integer
Dim arrSatir()
Dim arrveri()
Dim adres As String
If Trim(TextBox1) = Empty Then: ListBox2.Clear: TextBox2 = Empty: Exit Sub
Set sh = Sheets("Denetlemeler")
Set rg = sh.Range("AA1:AD65536")
Set bul = rg.Find(What:=TextBox1, Lookat:=xlPart)
ListBox2.Clear
'ListBox2.ColumnWidths = "20;100;100;100;100;100;100;100;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20;20"
TextBox2 = Empty
ListBox2.ColumnCount = 31
If Not bul Is Nothing Then
   adres = bul.Address
   Do
      If bul.Row = satir Or bul.Row = 1 Then: GoTo f1
      satir = bul.Row
      ReDim Preserve arrSatir(x)
      arrSatir(x) = bul.Row
      x = x + 1
f1:
      Set bul = rg.FindNext(bul)
   Loop While Not bul Is Nothing And bul.Address <> adres
End If
On Error Resume Next
ReDim Preserve arrveri(UBound(arrSatir) + 1, 0)
arrveri(0, 0) = "Sıra No"
For i = 1 To UBound(arrSatir) + 1
    arrveri(i, 0) = sh.Cells(arrSatir(i - 1), 1)
Next i
ReDim Preserve arrveri(UBound(arrSatir) + 1, 4)
arrveri(0, 1) = "Görevli-1": arrveri(0, 2) = "Görevli-2"
arrveri(0, 3) = "Görevli-3": arrveri(0, 4) = "Görevli-4"
For i = 1 To UBound(arrSatir) + 1
    For j = 1 To 4
        arrveri(i, j) = sh.Cells(arrSatir(i - 1), j + 26)
    Next j
Next i
ReDim Preserve arrveri(UBound(arrSatir) + 1, 30)
For i = 1 To 25
    arrveri(0, i + 4) = sh.Cells(1, i + 1)
Next i
For i = 1 To UBound(arrSatir) + 1
    For j = 5 To 29
        arrveri(i, j) = sh.Cells(arrSatir(i - 1), j - 3)
    Next j
Next i
ListBox2.List = arrveri
ListBox2.ListIndex = 0
TextBox2 = ListBox2.ListCount
Set sh = Nothing
End Sub

Yazdırma işlemi için de aşağıdaki kodları kullanınız.

Kod:

Private Sub Yazdır_Click()
Dim shR As Worksheet
Dim i As Integer
Dim arrYazdir()
If ListBox2.ListCount = 0 Then: Exit Sub
Set shR = Sheets("Rapor")
shR.Cells.ClearContents
ReDim arrYazdir(ListBox2.ListCount, 8)
For i = 0 To ListBox2.ListCount - 1
    arrYazdir(i, 0) = ListBox2.List(i, 1)
    arrYazdir(i, 1) = ListBox2.List(i, 2)
    arrYazdir(i, 2) = ListBox2.List(i, 3)
    arrYazdir(i, 3) = ListBox2.List(i, 4)
    arrYazdir(i, 4) = ListBox2.List(i, 5)
    arrYazdir(i, 5) = ListBox2.List(i, 8)
    arrYazdir(i, 6) = ListBox2.List(i, 12)
    arrYazdir(i, 7) = ListBox2.List(i, 13)
Next i
shR.Range("A1").Resize(ListBox2.ListCount, 8) = arrYazdir
shR.Range("A1:H" & shR.Cells(65536, 1).Row).Sort Key1:=shR.Range("G2"), _
                                                 Order1:=xlAscending, _
                                                 Header:=xlGuess, _
                                                 OrderCustom:=1, _
                                                 MatchCase:=False, _
                                                 Orientation:=xlTopToBottom, _
                                                 DataOption1:=xlSortNormal
shR.Select
Unload Me
Set shR = Nothing
End Sub

noxious · 17 Kasım 2007

Hocam tekrar Allah razı olsun

Yazdır kodunun sonuna

ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

kodları ekledim ve yazdır işlemi tamamlandı

Her şey mükemmel ancak tek sorun kaldı ListBox2 içerisinde sütun başlığı 1. sıradan başladı ama sabit değil ve sayma işlemi bu satırda sayıldığı için 1 fazla çıkıyor. Başlık satırı ListBox2 içerisinde en üstte sabit yapma imkanımız varmı neticede veri çok olduğunda scroll ile aşağı yukarı kaydırma işlemi yaptığımızda başlık satırı en başta olduğu için yukarı çıktığından kayboluyor. scroll ile yukarı aşağı kaydırdığımızda başlık satırı sabit kalsa sadece süzme işleminden kalan verilerimizi kaydırsak

Ferhat Pazarçevirdi · 17 Kasım 2007

Sütun başlığı, şu an kullandığınız nesne (Listbox) nedeniyle sabit olmaz zaten ...

Eğer ListBox'a verileri RowSource özelliği ile bağlayabilseydik -ki sizde filtreleme işlemi olduğu için bu mümkün değil- extra sabit bir başlık satırı ilave edilebilirdi.

Eğer Listbox yerine, Listview nesnesinin kullanmış olsaydınız, dediğiniz gibi üstte çok daha kullanışlı bir başlık satırı görülebilirdi.

Hatta Listview kullansaydınız, muhtemelen bu kadar array değişkenler tanımalamak ve bunları doldurmakla uğraşmak gerekmezdi. (Listbox nesnesine Additem'le 10 sütuna kadar yükleme sınırı var. Bunu aşmak için de array değişkenlere ihtiyaç vard&#305

Sonuç olarak; eldeki malzeme ile yapılabilecek en iyisini yaptık

Daha ilerisi için, Listeleme nesnenizi değiştirmek gerekiyor.

ancak tek sorun kaldı ListBox2 içerisinde sütun başlığı 1. sıradan başladı ama sabit değil ve sayma işlemi bu satırda sayıldığı için 1 fazla çıkıyor.

Bu sorunu aşmak için, TextBox2 = ListBox2.ListCount satırını TextBox2 = ListBox2.ListCount-1 olarak değiştirin

noxious · 17 Kasım 2007

Hocam Listbox ile Listview arasındaki farkı bilmiyordum bilseydim inanın o şekilde yapmaya çalışırdım. Neticede biz acemiler siz Uzman ve Hocalarımız sayesinde bir şeyler öğrenip yapmaya çalışıyoruz. Her şey için teşekkürler. Umarım yazdığınız kodlar bir başkasının da işine yarar. Saygılarımla

noxious · 18 Kasım 2007

Uzman arkadaşlarım, Hocalarım ...... Sayın FPC bana bu konuda çok şey öğretti ve yardımcı oldu. Ben konu son buldu diye düşünüyordum ama kurcaladıkça insanın aklına daha başka şeyler geliyor. Birinci Mesajımın ekinde bulunan Deneme Süz Son.rar dosyasında ufak bir değişiklik yaptım ve süzme işlemine tarih formatı ekledim ama ne kodları ekliyeceğimi bilmiyorum.

Tarih aralığı işaretlenirse süz işlemini o tarih aralığında yapsın eğer tarih işaretlenmez ise tümü üzerinde sorgu yapsın. Mümkün olacağını biliyorum çünkü excel de hemen hemen mümkün olmayan bir şey yok gibi az. Şimdiden teşekkürler.

noxious · 19 Kasım 2007

Tarih aralığı işaretlendikten sonra isim yazıldığında süz işlemini o tarih aralığında yapsın eğer tarih işaretlenmez ise isim yazıldığında tümü üzerinde sorgu yapsın.

Mümkünmü acaba

hsayar · 4 Eylül 2008

esenlikler sn noxious, dosyanın son halini ekleme şansınız var mı acaba?

vbmenu_register("postmenu_217989", true);

Koşullu süz yer değiştir ve yazdır

noxious

noxious

noxious

noxious

noxious

noxious

mesuttasar

Ferhat Pazarçevirdi

Özel Üye

noxious

Ferhat Pazarçevirdi

Özel Üye

noxious

Ferhat Pazarçevirdi

Özel Üye

noxious

Ferhat Pazarçevirdi

Özel Üye

noxious

noxious

noxious

hsayar