Alınmamış Eğitimleri Raporlama

[baykan_m]

Merhaba Arkadaşlar, Üstadlar,

Belli bir eğitim listem var. Bu listeye alınan eğitimleri yazıyorum. Ancak personelin almadığı eğitimleri de zaman zaman raporlayıp eğitimlerini vermem gerekiyor. Listede alınmamış olan eğitimleri raporlamak için yardımcı olabilir misiniz?Ek'li dosyada anlatmaya çalıştım umarım açıklayıcı olmuştur arkadaşlar.

İyi çalışmalar

 

[Ömer]

Merhaba,

Bu şekilde deneyin.

Sub Rapor_Al()
    
    Dim dizi(), S2 As Worksheet, i As Long, c As Range, Adr As String
    Dim j As Long, a, s, sut As Integer
    
    Set S2 = Sheets("Sayfa2")
    
    Application.ScreenUpdating = False
[COLOR="Red"]    Application.Calculation = xlManual[/COLOR]
    Sheets("Sayfa1").Select
    S2.Cells.Clear
    
    Range("L1:L" & Cells(Rows.Count, "L").End(xlUp).Row).Copy S2.[A1]
    Range("F1").Copy S2.[B1]
    
    For i = 2 To Cells(Rows.Count, "L").End(xlUp).Row
        sut = 2
        With [B:B]
            Set c = .Find(Cells(i, "L"), , xlValues, xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    ReDim Preserve dizi(a)
                    dizi(a) = Cells(c.Row, "F")
                    a = a + 1
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
        For j = 1 To Cells(Rows.Count, "K").End(xlUp).Row
            On Error Resume Next
            s = WorksheetFunction.Match(Cells(j, "K"), WorksheetFunction.Transpose(dizi), 0)
            If Err.Number <> 0 Then
                S2.Cells(i, sut) = Cells(j, "K")
                sut = sut + 1
            End If
        Next j
        Erase dizi
    Next i

    S2.Select
    Cells.EntireColumn.AutoFit
[COLOR="red"]    Application.Calculation = xlAutomatic[/COLOR]
    Application.ScreenUpdating = True
    
End Sub

.

 

[baykan_m]

Ömer Bey,

Öncelikle yardımınız için çok teşekkür ederim. Makro işimi görüyor ancak bende yaklaşık 6000 kayıt var o yüzden bu makro aşırı yavaş çalışıyor. Bunu çözme imkanımız olur mu ya da formülle işlem yapılabilir mi bu şekilde?

 

[Ömer]

Formülle çok daha yavaş olur ve dosyayı kasar.

Kodlara 2 satır ilave ettim. Son hali ile deneyiniz.

.

 

[baykan_m]

Kayıt fazla olduğu için pek bir değişiklik olmadı Ömer Bey. Kod yazma işini pek bilmiyorum ancak nacizane düşüncemi belirtmek istiyorum. İşlemde ters mantıkla gidersek, kişiye göre alınmamış eğitimleri değil de eğitim adına göre o eğitimi almamış kişileri çeksek bir değişim olur mu?