Sorgulama Yapma

[usunduz]

Değerli üstadlarım kısıtlı bilgimle forumda bulduğum vb kodlarını butona yerleştirmeme rağmen bir sonuç el edemedim daha çok ekmek yemem lazım sanırım..
neyse siz değerli üstadlardan niçin rahatsız ettim ; 2 ayrı sheet var çalışm sayfasında. biri veri diğeride sorgulama sayfası şeklinde. sorgulama sayfasında ad soyad olarak veya ad olarak veya sadece soyad olarak sorgulyarak yandaki hücreye yazmasını istiyorum lakin yapamadım...örnek tabla ekte, bu konuda yardımlarınızı talep ediyorum.Saygılarımla....

Şimdiden tşkler..

 

[asi_kral]

Değerli üstadlarım kısıtlı bilgimle forumda bulduğum vb kodlarını butona yerleştirmeme rağmen bir sonuç el edemedim daha çok ekmek yemem lazım sanırım..
neyse siz değerli üstadlardan niçin rahatsız ettim ; 2 ayrı sheet var çalışm sayfasında. biri veri diğeride sorgulama sayfası şeklinde. sorgulama sayfasında ad soyad olarak veya ad olarak veya sadece soyad olarak sorgulyarak yandaki hücreye yazmasını istiyorum lakin yapamadım...örnek tabla ekte, bu konuda yardımlarınızı talep ediyorum.Saygılarımla....

Şimdiden tşkler..

Merhaba
Boş bir module kopyalayın ve deneyin.

Option Explicit
Sub veri_bul_getir_1967()
'Konu       :   Ad ve Soyada Göre Listeleme
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Worksheet, kral As Long, a As Variant
Range("F3:I" & Rows.Count).ClearContents
a = ActiveCell.Address
Set asi = Sheets("veri")
kral = asi.Range("A" & Rows.Count).End(xlUp).Row
If Range("A2") <> Empty And Range("B2") = Empty Then
asi.Range("A1:D" & kral).AutoFilter field:=1, Criteria1:=Range("A2")
If WorksheetFunction.Subtotal(3, asi.Range("A2:A" & kral)) > 0 Then
asi.Range("A2:D" & kral).Copy
Range("F3").PasteSpecial (xlPasteValues)
End If
ElseIf Range("A2") = Empty And Range("B2") <> Empty Then
asi.Range("A1:D" & kral).AutoFilter field:=2, Criteria1:=Range("B2")
If WorksheetFunction.Subtotal(3, asi.Range("A2:A" & kral)) > 0 Then
asi.Range("A2:D" & kral).Copy
Range("F3").PasteSpecial (xlPasteValues)
End If
ElseIf Range("A2") <> Empty And Range("B2") <> Empty Then
asi.Range("A1:D" & kral).AutoFilter field:=1, Criteria1:=Range("A2")
asi.Range("A1:D" & kral).AutoFilter field:=2, Criteria1:=Range("B2")
If WorksheetFunction.Subtotal(3, asi.Range("A2:A" & kral)) > 0 Then
asi.Range("A2:D" & kral).Copy
Range("F3").PasteSpecial (xlPasteValues)
End If
End If
asi.Range("A1:D" & kral).AutoFilter
Range(a).Select
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[adsoft]

bende birşeyler yaptım umarım işini görür

Dim i
For i = 2 To 5000
If Sheets("veri").Range("a" & i) = Range("a2") Then
ekle = [f6500].End(3).Row + 1
Cells(ekle, "f").Value = Sheets("veri").Range("a" & i).Text
Cells(ekle, "g").Value = Sheets("veri").Range("b" & i).Text
Cells(ekle, "h").Value = Sheets("veri").Range("c" & i).Text
Cells(ekle, "I").Value = Sheets("veri").Range("d" & i).Text
 End If
Next i
DoEvents

 

[katip1981]

çok güzel bir excel çalışması olmuş kendime göre uyarlamak istedim lakin beceremedim, yardımcı olurmusunuz acaba...

ad- soyad- statü- dosyano şeklinde ve ad soyad olarak sorgulama yapıyor
bunu
tahliye tarihi - ad soyad-statü-dosyano şeklinde değiştirerek bugün formüllü tarihe göre sorgulama yapmasını istiyorum nasıl yapabilirim ?

 

[asi_kral]

çok güzel bir excel çalışması olmuş kendime göre uyarlamak istedim lakin beceremedim, yardımcı olurmusunuz acaba...

ad- soyad- statü- dosyano şeklinde ve ad soyad olarak sorgulama yapıyor
bunu
tahliye tarihi - ad soyad-statü-dosyano şeklinde değiştirerek bugün formüllü tarihe göre sorgulama yapmasını istiyorum nasıl yapabilirim ?

Dosya ekleseydiniz bu mesaj yerine kodu göndermiş olacaktım.

 

[katip1981]

haklısınız pardon dosya ekte saygılar...

 

[asi_kral]

haklısınız pardon dosya ekte saygılar...

Dosyanıza zahmet edip baktınız mı_?
1 tane kayıt var sence biz bu kayıtı ne yapabiliriz.
Biraz dosyaya veri girin ve sonuç kısmında ne görmek istiyorsunuz onu yazın bir görelim kodu yazıp gönderelim.

 

[katip1981]

çok pardon..düzelttim birazda veri girdim..ilgilendiğiniz için tşkler.

 

[asi_kral]

çok pardon..düzelttim birazda veri girdim..ilgilendiğiniz için tşkler.

Merhaba
Boş bir module kodu kopyalayın ve deneyin.

Option Explicit
Sub sorgula_1967()
'Konu       :   Tarih Ad ve Soyada Herhangi Birine Göre Sorgula _
Sonuçları Listele
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu1967@hotmail.com.tr
'Coder By   :   asi_kral_1967
Dim asi As Worksheet, kral As Long
Dim a As Long, b As Variant
Set asi = Sheets("Veri")
kral = asi.Range("A" & Rows.Count).End(xlUp).Row
Range("F3:J" & Rows.Count).ClearContents
b = ActiveCell.Address
For a = 1 To 3
If Cells(2, a) <> "" Then
If a = 1 Then
asi.Range("A1:E" & kral).AutoFilter field:=a, Criteria1:=">=" & CLng(Cells(2, a)), _
Operator:=xlAnd, Criteria2:="<=" & CLng(Cells(2, a))
Else
asi.Range("A1:E" & kral).AutoFilter field:=a, Criteria1:=Cells(2, a)
End If: End If: Next
If WorksheetFunction.Subtotal(3, asi.Range("A2:A" & kral)) > 0 Then
asi.Range("A2:E" & kral).Copy: Range("F3").PasteSpecial (xlPasteValues)
Else
MsgBox "Aradığınız Kriterlere Uygun Kayıt Bulunamadı", vbCritical, "Asi_kral_1967"
End If
asi.Range("A1:E" & kral).AutoFilter
Range(b).Select
MsgBox "İşlem Tamamlandı", vbInformation, "asi_kral_1967"
End Sub

Dosyanız Ekte.

 

[katip1981]

ellerinize sağlık.....harika*****

 

[asi_kral]

ellerinize sağlık.....harika*****

Kolay Gelsin.