sayfalar arasındaki aynı sayıyı bulma

ozedelec

Altın Üye
Katılım
16 Eylül 2018
Mesajlar
21
Beğeniler
0
Excel Vers. ve Dili
2010 türkçe
#1
çalışma kitabı içerisinde sayfalar arasında aynı yazılmış veriyi olan veriyi nasıl bulabilirim? ctrl f ile çalışma kitabında aradığımda bulabiliyorum ama çok veri var ve zaman isteyen bir iş? iki sayfadaki d sütünunda yazılmış aynı olan veriyi nasıl bulabilirim. diğer bir sayfaya nasıl taşırım?
 

Ekli dosyalar

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
24,777
Beğeniler
467
Excel Vers. ve Dili
OFFICE 2019 PRO TR
#2
Eklediğiniz dosyada "AHMET" sayfasında 4 adet ALİ var, MEHMET sayfasında 5 adet ALİ var. Bu durumda eşleştirmenin nasıl yapılmasını istiyorsunuz?

Daha kısaca özetlersek 3. sayfada görmek istediğiniz sonucu elle yazabilir misiniz?
 

ozedelec

Altın Üye
Katılım
16 Eylül 2018
Mesajlar
21
Beğeniler
0
Excel Vers. ve Dili
2010 türkçe
#3
tekrar edeni sadece bir kez bulunsun 3. sütunda. mümkün müdür acaba?
 

Ekli dosyalar

Korhan Ayhan

Moderatör
Yönetici
Katılım
15 Mart 2005
Mesajlar
24,777
Beğeniler
467
Excel Vers. ve Dili
OFFICE 2019 PRO TR
#4
Deneyiniz.

Kod:
Option Explicit

Sub D_SUTUNU_ORTAK_OLANLAR()
    Dim Sayfa As Worksheet, S1 As Worksheet, S2 As Worksheet, Zaman As Double
    Dim Son As Long, X As Integer, Y As Integer, Liste As Object
    
    Zaman = Timer
    
    Set S1 = Sheets("D SÜTÜNU ORTAK")
    
    Set Liste = CreateObject("Scripting.Dictionary")
    Liste.CompareMode = 1
    
    S1.Range("D4:D" & Rows.Count).ClearContents
    
    For Each Sayfa In ThisWorkbook.Worksheets
        Son = Sayfa.Cells(Rows.Count, 4).End(3).Row
        For X = 8 To Son
            For Y = 1 To Sheets.Count
                Set S2 = Sheets(Y)
                Select Case S2.Name
                    Case S1.Name, Sayfa.Name
                    Case Else
                    If WorksheetFunction.CountIf(S2.Range("D:D"), Sayfa.Cells(X, "D").Value) > 0 Then
                        If Not Liste.Exists(Sayfa.Cells(X, "D").Value) Then
                            Liste.Add Sayfa.Cells(X, "D").Value, Nothing
                        End If
                    End If
                End Select
            Next
        Next
    Next
    
    S1.Range("D4").Resize(Liste.Count) = Application.Transpose(Liste.Keys)
    
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 

ozedelec

Altın Üye
Katılım
16 Eylül 2018
Mesajlar
21
Beğeniler
0
Excel Vers. ve Dili
2010 türkçe
#5
Option Explicit Sub D_SUTUNU_ORTAK_OLANLAR() Dim Sayfa As Worksheet, S1 As Worksheet, S2 As Worksheet, Zaman As Double Dim Son As Long, X As Integer, Y As Integer, Liste As Object Zaman = Timer Set S1 = Sheets("D SÜTÜNU ORTAK") Set Liste = CreateObject("Scripting.Dictionary") Liste.CompareMode = 1 S1.Range("D4:D" & Rows.Count).ClearContents For Each Sayfa In ThisWorkbook.Worksheets Son = Sayfa.Cells(Rows.Count, 4).End(3).Row For X = 8 To Son For Y = 1 To Sheets.Count Set S2 = Sheets(Y) Select Case S2.Name Case S1.Name, Sayfa.Name Case Else If WorksheetFunction.CountIf(S2.Range("D:D"), Sayfa.Cells(X, "D").Value) > 0 Then If Not Liste.Exists(Sayfa.Cells(X, "D").Value) Then Liste.Add Sayfa.Cells(X, "D").Value, Nothing End If End If End Select Next Next Next S1.Range("D4").Resize(Liste.Count) = Application.Transpose(Liste.Keys) MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _ "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation End Sub
BECEREMEDİM SANIRIM
 
Üst