Makro Araması Bir Çalışıp Bir Çalışmıyor

[BarisDagidir]

Merhabalar, Yaklaşık 1-2 yıldır sizleri takip ediyorum, mükemmel formlar ve çalışmalar yapmamda çok faydalı oldunuz bu nedenle emeği geçen herkese teşekkürler.... ama artık tıkandım bu nedenle ekli formda desteğinize ihtiyacım var çünkü bu sefer sorunu çözemiyorum.

Öncelikle Macro VB bilgim çok az sadece burada bulduğum kodları yapıştırıp isim değişikliği ile uygulayamak ama üzerinde çalışıyorum umarım zamanla çözeceğim

Gelelim soruna, ekli dosyada yapmış olduğum açık işi bul seçeneğini dosyayı kapatıp açtığım zaman çalışmıyor sadece hata mesajını veriyor.
Ayrıca vb kapanmamış işi buldurup aynı satıra yazdıramadığım için en son satıra yazdırıyorum. BU nedenle son kapanmamış işi bulduramıyorum... Yardımlarınızı bekler, iyi çalışmalar dilerim :yardim: :yardim: :yardim:

 

[YUSUF44]

Hatalı cevap, dikkate almayınız.

 

[BarisDagidir]

Selamlar aslında yazdığım daha doğrusu kopyaladım kod da sadece olduğu yerde arama yapıyor sadece veri sayfasında değil... ondan dolayı ben sheet3 de arama yapmak istediğimde bulmuyor. Ama genel olarak sorun şu aramada sadece ilk kaydı buluyor ve bulup yanına yazdiramiyorum ... bununla ilgili birinin fikir vermesi mümkünmudur acaba ... (

 

[Korhan Ayhan]

Merhaba,

Dosyanızda yapmak istediğinize siz hakimsiniz. Ben yazdıklarınızdan tam olarak nasıl bir arama yapmaya çalıştığınızı çözemedim.

Açık işi bulmak için kullandığınız kodu aşağıdaki gibi değiştirip bir deneyiniz.

Private Sub Kytbul_Click()
    Dim ws As Worksheet
    Dim bak As Range
    Set ws = Worksheets("veri")
    ws.Select
    For Each bak In ws.Range("B2:B6500")
        If StrConv(bak.Value, vbUpperCase) = StrConv(namekd.Value, vbUpperCase) Then
            bak.Select
            Me.prjkd.Value = ActiveCell.Offset(0, -1).Value
            Me.namekd.Value = ActiveCell.Offset(0, 0).Value
            Me.iskd.Value = ActiveCell.Offset(0, 1).Value
            Exit Sub
        End If
    Next bak
    MsgBox "Aradığınız isimde bir kayıt bulunamadı"
End Sub

 

[BarisDagidir]

Merhabalar, ilginizden dolayı teşekkürler tam olarak aslında şöyle bahsedeyim;

İşe başladım butonunu kullandıktan sonra yazılan verinin Açık İşi Bul dediğimde buluyor ama XXX kişisine 2. bir iş yüklediğimde onu bulamıyor doğal olarak çünkü bir farklı bir kodu olması gerekiyor ama bunu nasıl şekillendireceğim konusunda bir fikir yaratamadım çünki işi bitirdim kısmında da aynı kodu vermesi lazım ya da işi bitirdim dediğimde ilk kaydını bulup XXX kişisinin G srununa onayı vermesi lazım ....


Özetlemek gerekirse XXXX işe başladı , açık İş kaydını bul dedi (G Sütunu Boş Olan), İşi Bitirdim dedi, bulunan kaydın G sütununa onayı verdi. İkinci defa XXXX işe başladı ve Açık İş Kaydını bul dediğinde 2. yazmış olduğu işi bulması yani G sütunu boş olan kaydı bulması ....

Okudunuz için teşekkürler....

 

[BarisDagidir]

çok basit bir halde sorayım .... aşağıdaki koda G sütunu boş olanı bul diyemiyorum

Private Sub Kytbul_Click()
    Dim ws As Worksheet
    Dim bak As Range
    Set ws = Worksheets("vrbtn")
    ws.Select
    For Each bak In ws.Range("B2:B6500")
        If StrConv(bak.Value, vbUpperCase) = StrConv(namekd.Value, vbUpperCase) Then
            bak.Select
            Me.prjkd.Value = ActiveCell.Offset(0, -1).Value
            Me.namekd.Value = ActiveCell.Offset(0, 0).Value
            Me.iskd.Value = ActiveCell.Offset(0, 1).Value
            Exit Sub
        End If
    Next bak
    MsgBox "Aradığınız isimde bir kayıt bulunamadı"
End Sub

 

[YUSUF44]

Sorunu çözer mi bilmiyorum ancak aşağıdaki kod parçası, G1:G100 aralığına tek tek bakar ve ilk boş hücreyi seçer:

for i = 1 to 100
if cells(i,"G") = "" then
cells(i,"G").select
i = 100
next

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki gibi deneyiniz.

Private Sub Kytbul_Click()
    Dim ws As Worksheet
    Dim bak As Range
    Set ws = Worksheets("vrbtn")
    ws.Select
    For Each bak In ws.Range("B2:B6500")
        If StrConv(bak.Value, vbUpperCase) = StrConv(namekd.Value, vbUpperCase) Then
            [COLOR="Red"]If ws.Cells(bak.Row, "G") = "" Then[/COLOR]
                bak.Select
                Me.prjkd.Value = ActiveCell.Offset(0, -1).Value
                Me.namekd.Value = ActiveCell.Offset(0, 0).Value
                Me.iskd.Value = ActiveCell.Offset(0, 1).Value
                Exit Sub
            [COLOR="red"]End If[/COLOR]
        End If
    Next bak
    MsgBox "Aradığınız isimde bir kayıt bulunamadı"
End Sub

 

[BarisDagidir]

Syn Korhan Ayhan vermiş olduğunuz kod çalışıyor teşekkür ederim,

Aslında her şey çalışıyor ama dosya boyutu çok büyük olduğu için (9,6 mb) makro kodlarını arıyorum.

Dosya ya bakarsanız; "çok uzatmışsın bunlara gerek yok bu şekilde bir yöntem daha rahat çalışmasına yardımcı olur" diyebileceğiniz şeyler olabilir, teşekkürler iyi çalışmalar.

Karşıdan yükleme bağlantısı
https://we.tl/XvZGJouC4m

/edit

 

[BarisDagidir]

Aşağıdaki koda sadece G sütununa yazması için kodu yazamadım .... yardımcı olabilir misiniz?

Private Sub isibitir_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("veri")

[U][B]ActiveCell.Select[/B][/U]
If Trim(Me.prjkd.Value) = "" Then
  Me.prjkd.SetFocus
  MsgBox "Proje Numarası Giriniz"
  Exit Sub
End If
If Trim(Me.namekd.Value) = "" Then
  Me.namekd.SetFocus
  MsgBox "İsminizi Giriniz!"
  Exit Sub
End If

If Trim(Me.iskd.Value) = "" Then
  Me.iskd.SetFocus
  MsgBox "Yapılacak İşi Giriniz!"
  Exit Sub
End If

With ws
[U][B]ActiveCell.Cells(Row, Range("G" + 1)).Value = "0"[/B][/U]
 
 End With


Me.prjkd.Value = ""
Me.namekd.Value = ""
Me.iskd.Value = ""
Me.prjkd.SetFocus
End Sub