İki Sütun Verilerini Karşılaştırma

[Feylosof]

Herkese İyi çalışmalar diliyorum.
Altın üyeliğim bitmiş okul internetinden harici sitelerden dosya yüklenmiyor. Olmazsa dosyayı eve gidince yükleyeceğim. Dosya 3 kişi için 4 14 ve 24. satırlara gelmeyen raporlu öğretmen yazıldıktan sonra o öğretmenlerin yerine başka öğretmen görevlendirmek istiyorum. çakışmayı önlemek için aynı öğretmeni aynı ders saatinde birden fazla görevlendirme yapmamak için uyarı eklemek istiyorum. A sütunu Ders saatini göstermektedir. C sütununda görevlendirilen öğretmenler var. Farklı ders saatlerinde aynı öğretmen birden fazla görevlendirilebilir ama aynı ders saatinde görevlendirme yapmaması için uyarı vermesini VBA yoluyla yapmak istiyorum.

	Raporlu / Görevli Öğretmen :
DERS SAATİ	GÖREVLENDİRİLDİĞİ SINIF	GÖREVLENDİRİLEN ÖĞRETMEN	İMZA
1		ayşe
2		mehmet	örnek 1
3		ahmet	örnek 2
4		efe
5		hakan
6		hakan
7
8
	Raporlu / Görevli Öğretmen :
DERS SAATİ	GÖREVLENDİRİLDİĞİ SINIF	GÖREVLENDİRİLEN ÖĞRETMEN	İMZA
1
2		mehmet
3		hasan
4		fatma
5		seyit
6		osman
7
8
	Raporlu / Görevli Öğretmen :
DERS SAATİ	GÖREVLENDİRİLDİĞİ SINIF	GÖREVLENDİRİLEN ÖĞRETMEN	İMZA
1
2
3		ahmet
4
5
6
7
8

 

[muhasebeciyiz]

Aynı öğretmenin aynı ders saatinde (A sütunu) birden fazla kez C sütununa yazılmasını engellemek için en pratik yol Worksheet_Change olayıyla kontrol edip uyarı verip hücreyi geri boşaltmak.Aşağıdaki kodu ilgili sayfanın (Sheet’in) kod bölümüne ekleyin:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, c As Range
    Dim dersSaati As Variant
    Dim ogretmen As String
    Dim adet As Long
  
    Set rng = Intersect(Target, Me.Columns("C"))
    If rng Is Nothing Then Exit Sub

    On Error GoTo SafeExit
    Application.EnableEvents = False
  
    For Each c In rng.Cells
        ogretmen = NormalizeName(CStr(c.Value))
        If Len(ogretmen) = 0 Then GoTo NextCell

        dersSaati = Me.Cells(c.Row, "A").Value
        If Len(Trim(CStr(dersSaati))) = 0 Then GoTo NextCell
      
        adet = Application.WorksheetFunction.CountIfs( _
                    Me.Columns("A"), dersSaati, _
                    Me.Columns("C"), ogretmen)

        If adet > 1 Then
            MsgBox "ÇAKIŞMA!" & vbCrLf & _
                   "Ders saati: " & dersSaati & vbCrLf & _
                   "Öğretmen: " & ogretmen & vbCrLf & vbCrLf & _
                   "Aynı ders saatinde bu öğretmen başka bir yere zaten görevlendirilmiş.", _
                   vbExclamation, "Görevlendirme Uyarısı"
          
            c.ClearContents
        End If

NextCell:
    Next c

SafeExit:
    Application.EnableEvents = True
End Sub

Private Function NormalizeName(ByVal s As String) As String
  
    s = Trim(s)
    Do While InStr(s, "  ") > 0
        s = Replace(s, "  ", " ")
    Loop
    NormalizeName = s
End Function

C sütununa bir öğretmen adı yazıldığında (veya yapıştırıldığında),
Aynı öğretmenin aynı ders saati (A) için C sütununda başka yerde de olup olmadığını kontrol eder,
Varsa uyarı verir ve yazılan hücreyi boşaltır (çakışmayı fiilen engeller).
Farklı ders saatlerinde aynı öğretmen yazılabilir (sorun değil).

 

[Feylosof]

@muhasebeciyiz üstadım ilgi ve desteğiniz için çok teşekkür ederim. Bu kodu USERFORM üzerinde bir düğmeye bağlayabilir miyiz?

 

[zeki140]

@muhasebeciyiz iyi günler. A sütununda öğrenci ad soyadları var C sütununda banka aidat gelir döküm listesi var (veli adı soyadı öğrenci adı soyadı) B sutununa öğrenci isimleri karşısına aidat yatırdı -yada yatırmadı şeklinde bir vba kartştırma kod lazım yardımcı olabilecek abiler varmı. forumda buldum ama hepsini karşılaştırmıyor. bazılarını buluyor bazılarını bulmuyor. şimdiden teşekkürler.

 

[muhasebeciyiz]

Standart modüle ekleyin

Option Explicit

Public Sub DersSaatiCakismaKontrolu(ws As Worksheet)
    Dim sonSatir As Long
    Dim i As Long, j As Long
    Dim ders1, ders2
    Dim ogr1 As String, ogr2 As String
    Dim mesaj As String

    sonSatir = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    For i = 1 To sonSatir
        ogr1 = NormalizeName(ws.Cells(i, "C").Value)
        ders1 = ws.Cells(i, "A").Value

        If ogr1 <> "" And ders1 <> "" Then
            For j = i + 1 To sonSatir
                ogr2 = NormalizeName(ws.Cells(j, "C").Value)
                ders2 = ws.Cells(j, "A").Value

                If ogr1 = ogr2 And ders1 = ders2 Then
                    mesaj = mesaj & _
                             "Çakışma!" & vbCrLf & _
                             "Ders Saati: " & ders1 & vbCrLf & _
                             "Öğretmen: " & ogr1 & vbCrLf & _
                             "Satırlar: " & i & " - " & j & vbCrLf & vbCrLf
                End If
            Next j
        End If
    Next i

    If mesaj <> "" Then
        MsgBox mesaj, vbExclamation, "Görevlendirme Çakışmaları"
    Else
        MsgBox "Çakışma bulunamadı.", vbInformation, "Kontrol Sonucu"
    End If
End Sub

Public Function NormalizeName(ByVal s As String) As String
    s = Trim(s)
    Do While InStr(s, "  ") > 0
        s = Replace(s, "  ", " ")
    Loop
    NormalizeName = s
End Function

UserForm’daki butonun Click olayına:"Sheet1" yerine kendi sayfa adınızı yazın

Private Sub CommandButton1_Click()
    Call DersSaatiCakismaKontrolu(Sheets("Sheet1"))
End Sub

 

[Feylosof]

Standart modüle ekleyin

Option Explicit

Public Sub DersSaatiCakismaKontrolu(ws As Worksheet)
    Dim sonSatir As Long
    Dim i As Long, j As Long
    Dim ders1, ders2
    Dim ogr1 As String, ogr2 As String
    Dim mesaj As String

    sonSatir = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

    For i = 1 To sonSatir
        ogr1 = NormalizeName(ws.Cells(i, "C").Value)
        ders1 = ws.Cells(i, "A").Value

        If ogr1 <> "" And ders1 <> "" Then
            For j = i + 1 To sonSatir
                ogr2 = NormalizeName(ws.Cells(j, "C").Value)
                ders2 = ws.Cells(j, "A").Value

                If ogr1 = ogr2 And ders1 = ders2 Then
                    mesaj = mesaj & _
                             "Çakışma!" & vbCrLf & _
                             "Ders Saati: " & ders1 & vbCrLf & _
                             "Öğretmen: " & ogr1 & vbCrLf & _
                             "Satırlar: " & i & " - " & j & vbCrLf & vbCrLf
                End If
            Next j
        End If
    Next i

    If mesaj <> "" Then
        MsgBox mesaj, vbExclamation, "Görevlendirme Çakışmaları"
    Else
        MsgBox "Çakışma bulunamadı.", vbInformation, "Kontrol Sonucu"
    End If
End Sub

Public Function NormalizeName(ByVal s As String) As String
    s = Trim(s)
    Do While InStr(s, "  ") > 0
        s = Replace(s, "  ", " ")
    Loop
    NormalizeName = s
End Function

UserForm’daki butonun Click olayına:"Sheet1" yerine kendi sayfa adınızı yazın

Private Sub CommandButton1_Click()
    Call DersSaatiCakismaKontrolu(Sheets("Sheet1"))
End Sub

Eyvallah Allah razı olsun. Emeğinize ve zihninize sağlık