• DİKKAT

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

Otomatik tablo yapımı

K

kayahan84

Katılım
9 Haziran 2007
Mesajlar
43
Excel Vers. ve Dili
excel 2010 English Türkçe
Arkadaşlar herkese merhaba, istemiş olduğum şey, sheet 1 deki bilgileri isim ve ya is numarasi girerek otomatik tablo olarak çıkarmasını istiyorum bu konuda yardımcı olursanız sevinirim. Şimdiden çok teşekkürler

Örnek
Shett1 de adı, soyadı, adresi, servis guzergahi ve vardiyasi yazan bir liste var, sheet 2 de ise isim ya da iş numarası girerek ( 62611) sheet 2 ye otomatik olarak kişileri tablo formatında eklemesi. Kişi 1 den fazla 20 ye kadar olabilir şimdiden teşekkürler

Örnek Dosya eklenmiştir
 

Ekli dosyalar

Son düzenleme:
Örnek Excel dosyanızı Forum'a ekleyip sayfalar üzerinde bilgilerin nasıl ve hangi formatta alınacağını belirtirseniz, daha kolay cevap alabilirsiniz.
Cevaplar; makro ile olabileceği gibi, belirleyeceğiniz koşullara göre Formülle de olabilir.Hangisi uygunsa ona göre kullanabilirsiniz.
 
turist' Alıntı:
Örnek Excel dosyanızı Forum'a ekleyip sayfalar üzerinde bilgilerin nasıl ve hangi formatta alınacağını belirtirseniz, daha kolay cevap alabilirsiniz.
Cevaplar; makro ile olabileceği gibi, belirleyeceğiniz koşullara göre Formülle de olabilir.Hangisi uygunsa ona göre kullanabilirsiniz.
Genişletmek için tıkla ...


Dosya ekledim olmuş mu?
 
Emeğiniz teşekkürler, ancak çalışmıyor hata veriyor
 
Merhaba,

Çalışmayan kısım nedir?

Nasıl bir hata alıyorsunuz. Detay belirtir misiniz?
 
Mesai Tablosu sayfasına aşağıdaki kodları ekleyin.
Kod: 
Private Sub TextBox1_Change()
Dim s1, s2 As Worksheet
Set s1 = Sheets("KİŞİ BİLGİSİ")
Set s2 = Sheets("MESAİ TABLOSU ")

On Error Resume Next
If TextBox1.Text <> "" Then
      Deg = TextBox1.Text
Else
      s1.Range("h:h").ClearContents
      s2.Range("A11:G65000").ClearContents
      MsgBox "Lütfen bir arama kriteri girin..."
      Exit Sub
       
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
    
 sonsat = s1.Range("A" & Rows.Count).End(xlUp).Row
 s1.Range("h:h").ClearContents
 s1.Cells(1, 8) = "ADI SOYADI"
 For i = 2 To sonsat
    s1.Cells(i, 8) = s1.Cells(i, 3) & " " & s1.Cells(i, 3)
 Next
    
    s2.Range("A11:G65000").ClearContents
   
    s1.Range("h1").AutoFilter
    
    s1.Range("h1").AutoFilter Field:=8, Criteria1:="*" & Deg & "*"
    
    s1.Range("A2:G" & sonsat).SpecialCells(xlCellTypeVisible).Copy Range("A11")
    s1.Range("h1").AutoFilter

Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

Private Sub TextBox2_Change()

Dim s1, s2 As Worksheet
Set s1 = Sheets("KİŞİ BİLGİSİ")
Set s2 = Sheets("MESAİ TABLOSU ")
On Error Resume Next
If TextBox2.Text <> "" Then
      Deg = TextBox2.Text
Else
      MsgBox "Lütfen bir arama kriteri girin..."
      Exit Sub
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
      
    Range("A11:G65000").ClearContents


    sonsat = s1.Range("A" & Rows.Count).End(xlUp).Row
    s1.Range("b2").AutoFilter
    
    s1.Range("b2").AutoFilter Field:=2, Criteria1:=Deg
    
    s1.Range("A2:G" & sonsat).SpecialCells(xlCellTypeVisible).Copy Range("A11")
    s1.Range("B1").AutoFilter
  Set s1 = Nothing
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
 
NBATMAN' Alıntı:
Merhaba,

Ekteki programı dener misiniz?
Genişletmek için tıkla ...

merhaba, teşekkür ederim ancak istediğim bu değil maalesef ben yukarda attığım formatta 500 kişinin datasının olduğu bir listeden kişiler adını ya da sicil nosunu yazdığımda o kişiye ait nekadar bilgi varsa otomatik olarak listelenecek bunda onu yapamadım maalesef sanırım beceremedim
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst