Soru Bulunacak değerlere ilave talebi.

reosman · 5 Temmuz 2021

Saygıdeğer üstadlarım.

Bir türlü beceremediğim,
Ekte sunduğum resimdede görükeceği üzere İz ve İz Arşiv sayfalarında
bulunan tarih kısımlarınında bulunan kısmına ilave edilmesini talep ediyorum.

reosman · 5 Temmuz 2021

Yardımlarınızı rica ediyorum.

reosman · 5 Temmuz 2021

Arama yaptığım form Userform1 bu formdaki listbox'a İz ve İz Arşiv sayfalarındaki Tarih kısımları F sütunları ilave edilecek.

reosman · 6 Temmuz 2021

Günaydınlar, Merhabalar, Hayırlı Günler

reosman · 6 Temmuz 2021

Üstadlarım yardımlarınızı rica ediyorum.

reosman · 6 Temmuz 2021

Üstadlarım saygılarımla.

reosman · 6 Temmuz 2021

Rica ediyorum bir yardım

reosman · 6 Temmuz 2021

üstadlar lütfen rica ediyorum bir el atın

reosman · 7 Temmuz 2021

Sorum günceldir.

reosman · 7 Temmuz 2021

Güncel.

muratboz06 · 7 Temmuz 2021

dosya.tc sitesine dosyanızı ve ekran görüntüsünü ekleyerek paylaşınız.
Bakalım.

reosman · 7 Temmuz 2021

Murat bey ilginize teşekkür ederim. Yukarıda hem ekran görüntüsü hem de dosya var yinede yükleyelim.

https://s5.dosya.tc/server4/ps2ulm/ADYS_8.0__BS_.xlsm.html

https://s5.dosya.tc/server4/ps2ulm/Adsiz.png.html

reosman · 7 Temmuz 2021

Murat bey yükledim size zahmet olacak.

reosman · 7 Temmuz 2021

Bir türlü başaramadım.

reosman · 8 Temmuz 2021

Kod:

Private Sub CommandButton1_Click()
Dim k As Range, ilk_adres As String, A As Long
Dim i  As Long, syf As String, myarr()
ListBox1.Clear
If TextBox1.Value = "" Then
    MsgBox "Lütfen Sicil Numarasını Giriniz !!!", 16, "Dikkat"
    End If
    If TextBox1.Value = "" Then Exit Sub
        ReDim myarr(1 To 3, 1 To 1)
For i = 1 To ComboBox1.ListCount - 1
    If ComboBox1.Value <> "HEPSİ" Then
        syf = ComboBox1.Value
        Else
        syf = ComboBox1.Column(0, i)
    End If
    Set k = Sheets(syf).[D:D].Find(TextBox1.Value, , xlValues, xlWhole, , 1)
    If Not k Is Nothing Then
        ilk_adres = k.Address
        Do
        A = A + 1
        ReDim Preserve myarr(1 To 3, 1 To A)
        myarr(1, A) = syf
        myarr(2, A) = k.Address(False, False)
        myarr(3, A) = k.Value
        Set k = Sheets(syf).[D:D].FindNext(k)
        Loop While ilk_adres <> k.Address And Not k Is Nothing
    End If
    If ComboBox1.Value <> "HEPSİ" Then Exit For
    Next i
    Set k = Nothing
    Label3.Caption = "Kriterlere Uyan " & A & " Adet Kayıt Bulundu..!!"
    If A > 0 Then
        ListBox1.Column = myarr
        Erase myarr
        MsgBox "Aranan Kayıtlar Listelendi!!", vbOKOnly + vbInformation, "ARA-BUL"
    End If
    If A < 1 Then MsgBox "Aradığınız Veri Bulunamadı..!!", vbCritical, "DİKKAT"
    TextBox1.Value = ""
    TextBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub Textbox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Then
    Call CommandButton1_Click
End If
Call TextBox1.SetFocus
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListCount < 1 Then Exit Sub
Sheets(ListBox1.Column(0, ListBox1.ListIndex)).Select
Range(ListBox1.Column(1)).Select
End Sub
Private Sub TextBox1_Change()
    If Not (IsNumeric(TextBox1)) Then SendKeys "{bs}"
End Sub
Private Sub UserForm_Initialize()
Dim syf As Worksheet
ComboBox1.AddItem "HEPSİ"
For Each syf In Worksheets
    ComboBox1.AddItem syf.Name
Next
ComboBox1.ListIndex = 0
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "100;80;80"
TextBox1.SetFocus
End Sub
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger _
, ByVal Shift As Integer)
    If KeyCode = 27 Then Unload Me
End Sub

YUSUF44 · 8 Temmuz 2021

Userform'in kodlarını aşağıdakiyle değiştirip deneyiniz. Tabi formun boyutlarında ve yerleşiminde de düzeltme yapmanız gerekecek, onları halledersiniz:

PHP:

Private Sub CommandButton1_Click()
Dim k As Range, ilk_adres As String, A As Long
Dim i  As Long, syf As String, myarr()
ListBox1.Clear
If TextBox1.Value = "" Then
    MsgBox "Lütfen Sicil Numarasını Giriniz !!!", 16, "Dikkat"
    End If
    If TextBox1.Value = "" Then Exit Sub
        ReDim myarr(1 To 4, 1 To 1)
For i = 1 To ComboBox1.ListCount - 1
    If ComboBox1.Value <> "HEPSİ" Then
        syf = ComboBox1.Value
        Else
        syf = ComboBox1.Column(0, i)
    End If
    Set k = Sheets(syf).[D:D].Find(TextBox1.Value, , xlValues, xlWhole, , 2)
    If Not k Is Nothing Then
        ilk_adres = k.Address
        Do
        A = A + 1
        ReDim Preserve myarr(1 To 4, 1 To A)
        myarr(1, A) = syf
        myarr(2, A) = k.Address(False, False)
        myarr(3, A) = k.Value
        If syf = "İz" Or syf = "İz Arşiv" Then
            myarr(4, A) = k.Offset(0, 2)
        End If
              
        Set k = Sheets(syf).[D:D].FindNext(k)
        Loop While ilk_adres <> k.Address And Not k Is Nothing
    End If
    If ComboBox1.Value <> "HEPSİ" Then Exit For
    Next i
    Set k = Nothing
    Label3.Caption = "Kriterlere Uyan " & A & " Adet Kayıt Bulundu..!!"
    If A > 0 Then
        ListBox1.Column = myarr
        Erase myarr
        MsgBox "Aranan Kayıtlar Listelendi!!", vbOKOnly + vbInformation, "ARA-BUL"
    End If
    If A < 1 Then MsgBox "Aradığınız Veri Bulunamadı..!!", vbCritical, "DİKKAT"
    TextBox1.Value = ""
    TextBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub Textbox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Then
    Call CommandButton1_Click
End If
Call TextBox1.SetFocus
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListCount < 1 Then Exit Sub
Sheets(ListBox1.Column(0, ListBox1.ListIndex)).Select
Range(ListBox1.Column(1)).Select
End Sub
Private Sub TextBox1_Change()
    If Not (IsNumeric(TextBox1)) Then SendKeys "{bs}"
End Sub
Private Sub UserForm_Initialize()
Dim syf As Worksheet
ComboBox1.AddItem "HEPSİ"
For Each syf In Worksheets
    ComboBox1.AddItem syf.Name
Next
ComboBox1.ListIndex = 0
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "100;80;80;80"
TextBox1.SetFocus
End Sub
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger _
, ByVal Shift As Integer)
    If KeyCode = 27 Then Unload Me
End Sub

muratboz06 · 8 Temmuz 2021

Kod:

Private Sub CommandButton1_Click()
Dim k As Range, ilk_adres As String, A As Long
Dim i  As Long, syf As String, myarr()
ListBox1.Clear
If TextBox1.Value = "" Then
    MsgBox "Lütfen Sicil Numarasını Giriniz !!!", 16, "Dikkat"
    End If
    If TextBox1.Value = "" Then Exit Sub
        ReDim myarr(1 To 4, 1 To 1)
For i = 1 To ComboBox1.ListCount - 1
    If ComboBox1.Value <> "HEPSİ" Then
        syf = ComboBox1.Value
        Else
        syf = ComboBox1.Column(0, i)
    End If
    Set k = Sheets(syf).[D:D].Find(TextBox1.Value, , xlValues, xlWhole, , 2)
 
    If Not k Is Nothing Then
        ilk_adres = k.Address
        Do
        A = A + 1
        ReDim Preserve myarr(1 To 4, 1 To A)
        myarr(1, A) = syf
        myarr(2, A) = k.Address(False, False)
        myarr(3, A) = k.Value
        myarr(4, A) = k.Offset(0, 2).Value
          
        Set k = Sheets(syf).[D:D].FindNext(k)
        Loop While ilk_adres <> k.Address And Not k Is Nothing
    End If
    
    If ComboBox1.Value <> "HEPSİ" Then Exit For
    Next i
    ' MsgBox k.Offset(0, 2).Value
    Set k = Nothing
    Label3.Caption = "Kriterlere Uyan " & A & " Adet Kayıt Bulundu..!!"
    If A > 0 Then
        ListBox1.Column = myarr
        Erase myarr
        MsgBox "Aranan Kayıtlar Listelendi!!", vbOKOnly + vbInformation, "ARA-BUL"
    End If
    If A < 1 Then MsgBox "Aradığınız Veri Bulunamadı..!!", vbCritical, "DİKKAT"
    TextBox1.Value = ""
    TextBox1.SetFocus
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub Textbox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyReturn Then
    Call CommandButton1_Click
End If
Call TextBox1.SetFocus
End Sub
Private Sub ListBox1_Click()
If ListBox1.ListCount < 1 Then Exit Sub
Sheets(ListBox1.Column(0, ListBox1.ListIndex)).Select
Range(ListBox1.Column(1)).Select
End Sub

Private Sub UserForm_Initialize()
Dim syf As Worksheet
ComboBox1.AddItem "HEPSİ"
For Each syf In Worksheets
    ComboBox1.AddItem syf.Name
Next
ComboBox1.ListIndex = 0
ListBox1.ColumnCount = 4
ListBox1.ColumnWidths = "50;50;50;50"
TextBox1.SetFocus
End Sub
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger _
, ByVal Shift As Integer)
    If KeyCode = 27 Then Unload Me
End Sub

ListBox1.ColumnWidths = "50;50;50;50" satırını kendinize göre güncellersiniz.

reosman · 8 Temmuz 2021

RABBİM sizlerden razı olsun. Deneyip bilgi vereceğim. Saygılarımla. Çok çok teşekkür ederim.

reosman · 8 Temmuz 2021

Üstadlarım harikasınız sadece bulunduğunda çıkan tarih 6/22/2021 şeklinde
bunu 22/06/2021 veya 22.06.2021 şeklinde düzeltebilirmiyiz ?

YUSUF44 · 8 Temmuz 2021

reosman' Alıntı:
Üstadlarım harikasınız sadece bulunduğunda çıkan tarih 6/22/2021 şeklinde
bunu 22/06/2021 veya 22.06.2021 şeklinde düzeltebilirmiyiz ?

İlgili satırı aşağıdakiyle değiştirin:

myarr(4, A) = Format(k.Offset(0, 2), "dd/mm/yyyy")

Soru Bulunacak değerlere ilave talebi.

reosman

Ekli dosyalar

reosman

reosman

reosman

reosman

reosman

reosman

reosman

reosman

reosman

muratboz06

Destek Ekibi

reosman

reosman

reosman

reosman

YUSUF44

Destek Ekibi

muratboz06

Destek Ekibi

reosman

reosman

YUSUF44

Destek Ekibi