Isimlerin ne kadar çalıştığı

[abbasonline]

Dosya ekinde anlatım mevcut..

 

[abbasonline]

Makro ile ilgili

 

[zafer]

Merhaba

Sayfa2'seki isimler nasıl sıralanıyor.
Ali 1 ve 2. işe gitmiş 3.işe gitmemiş
veli 3. işe gitmiş diyorsunuz

bu işe gidiş bilgileri nerede tutuluyor bunlar olmadan düzenlemeyi nasıl yapacağız ?

 

[abbasonline]

SAYFA 2 YE İSİMLERİ WORDDAN ALIP SAYFA 2 DE a3 SÜTUNUNDAN AŞAĞIYA DOĞRU YAPIŞTIRACAĞIM, İŞE GİDİŞ BİLGİLERİNİ KENDİM ELLE SAYFA 1 YAZACAĞIM KENDİML BİLMEM AÇISINDAN SADECE SAYFA 2 YE YAPIŞTIRMIŞ OLDUĞUM İSİMLERİ SAYFA 1 DE BULUP KARŞISINA (x) KOYMASINI İSTİYORUM HER (x) İŞARET KOYDUĞUNDA YAN YANA KOYACAK İSİM VAR İSE, YOK İSE BOŞ GEÇECEK

 

[abbasonline]

sadece makro ile (X) işaretini, isimlerin karşısına, Sayfa ikiye yazdığım isimlere koymasını istiyorum. Sayfa ikiye A3 den itibaren her isim yazdığımda Sayfa 1 de bulup karşısına (X) koysun ancak sayfa 2 de aynı isim olmadığında Sayfa 1 deki karşılığı boş geçsin, birdaha tekrar Sayfa 1 de A3 den itibaren aşağıya doğru isim yazdığımda önceki olmayan isim yazıldığında, boş bırakmış olduğu((X) işaeretini koymadığı hücrenin sağından tekrar devam etsin (daha sonra Sayfa 1 bakıldığında o hücre boş olarak görülsün)

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub GÖREVLERİ_LİSTELE()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim KAÇINCI_GÖREV As Variant, X As Long
    
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    
    KAÇINCI_GÖREV = Application.InputBox("Kaçıncı görevi aktarmak istiyor sunuz?")
    
    If KAÇINCI_GÖREV = "" Or KAÇINCI_GÖREV = False Then
        MsgBox "Kaçıncı görev bilgisini girmediğiniz için işleminiz iptal edilmiştir !", vbExclamation
        Exit Sub
    End If
    
    For X = 3 To S1.Range("A65536").End(3).Row
        If WorksheetFunction.CountIf(S2.Range("A:A"), S1.Cells(X, 1)) > 0 Then
            S1.Cells(X, KAÇINCI_GÖREV + 1) = "X"
        End If
    Next
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[abbasonline]

Korhan bey sağolun güzel olmuş, ancak bana kaçıncı görev olarak sormadan sıradan kendisi yapabilirmi aynı şekilde, sadece kaçıncı görev olduğunu sormayacak Teşekkürler.

 

[abbasonline]

SAYFA 1 DE İSİMLER C Sütunundan 3 satırdan başlarsa kodda nasıl değişiklik yapmam gerekli.

 

[abbasonline]

düzeltildi, ilgilenen arkadaşlara teşekkürler.

 

[Korhan Ayhan]

Selamlar,

Sorununuz çözümlendimi?

 

[abbasonline]

doğrudur çözümlendi ilginiz için teşekkürler.

 

[abbasonline]

Korhan bey aynı şekilde Sayfa2 deki isimlerden çeteleye işlenmeyenler var ise onlar kırmızı olabilirmi, (örneğin ismi yanlış yazdım, sayalım çetele işlenmeyecek tabiki bunu nasıl tesbit edebilirim.)

 

[abbasonline]

Korhan bey nasıl yapabilirim.

 

[Korhan Ayhan]

Selamlar,

Sanıyorum siz kodda kendinizce düzeltmeler yaptınız. Kodun çalışan son halini eklerseniz onun üzerinden çözüme daha kolay gidebiliriz.

 

[abbasonline]

Option Explicit

Sub GÖREVLERİ_LİSTELE()
Dim S1 As Worksheet, S2 As Worksheet
Dim KAÇINCI_GÖREV As Variant, X As Long

Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")

KAÇINCI_GÖREV = Application.InputBox("Kaçıncı görevi aktarmak istiyor sunuz?")

If KAÇINCI_GÖREV = "" Or KAÇINCI_GÖREV = False Then
MsgBox "Kaçıncı görev bilgisini girmediğiniz için işleminiz iptal edilmiştir !", vbExclamation
Exit Sub
End If

For X = 3 To S1.Range("D65536").End(3).Row
If WorksheetFunction.CountIf(S2.Range("A:A"), S1.Cells(X, 4)) > 0 Then
S1.Cells(X, KAÇINCI_GÖREV + 5) = "X"
End If
Next

Set S1 = Nothing
Set S2 = Nothing

MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Sub GÖREVLERİ_LİSTELE()
    Dim S1 As Worksheet, S2 As Worksheet, BUL As Range
    Dim KAÇINCI_GÖREV As Variant, X As Long, Satır As Long
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Satır = 3
 
    S2.Range("D:D").ClearContents
 
    KAÇINCI_GÖREV = Application.InputBox("Kaçıncı görevi aktarmak istiyor sunuz?")
 
    If KAÇINCI_GÖREV = "" Or KAÇINCI_GÖREV = False Then
        MsgBox "Kaçıncı görev bilgisini girmediğiniz için işleminiz iptal edilmiştir !", vbExclamation
        Exit Sub
    End If
 
    For X = 3 To S2.Range("A65536").End(3).Row
        Set BUL = S1.Range("D:D").Find(S2.Cells(X, "A"), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
            S1.Cells(BUL.Row, KAÇINCI_GÖREV + 5) = "X"
        Else
            S2.Cells(Satır, "D") = S2.Cells(X, "A")
            Satır = Satır + 1
        End If
    Next
 
    If WorksheetFunction.CountA(S2.Range("D:D")) > 0 Then
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & "Toplam " & _
        WorksheetFunction.CountA(S2.Range("D:D")) & " adet isim bulunamadı !" & Chr(10) & _
        "Lütfen Sayfa2 'den kontrol ediniz !", vbCritical
    Else
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    End If
 
    Set BUL = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
End Sub

 

[abbasonline]

Teşekürler Korhan bey çok harika olmuş ellerinize sağlık, teşekkür ederim, kolay gelsin.