Sütunları Karşılaştırma

[muratozmenler]

Merhabalar;

İsim	Önceki Yıl Son	Yıl
murat	100​	2023​
mehmet	85​	2023​
hasan	45​	2023​

kapanış isimli sayfamda A-B-C sütunlarında bu şekil verilerim mevcut.



Yapmak istediğim kapanış isimli sayfadaki A2:C sütununu Rapor sayfasının A2:C sütunun da arayacak varsa işlem yapmasın yoksa eğer Rapor sayfasının A2:C sütununa kapanış sayfasının A2:C sütunundaki olmayan verileri son satıra ilave ederek aktarma yapsın. Rapor sayfasındaki veriler kalsın alt satıra devam ederek aktarma yapsın olmayanları

Teşekkür ederim.

 

[muratozmenler]

Yardımlarınızı bekliyorum.

 

[sbayyigit]

Karşılaştırma için neyi baz alacağız? Sadece isim olup olmaması mı önemli. Yoksa önceki yılda bulunan değer de önemli mi?
Örnek dosya gönderebilirseniz yardımcı olunabilir.

 

[excelokyanus500]

Deneyin..

Sub karsilastir2()
    Dim rngCell As Range, sdrange As Range
    Dim sf As Worksheet, sd As Worksheet
    Dim alan1 As String, alan2 As String
    

    Set sf = Sheets("kapanış")
    Set sd = Sheets("Rapor")


    For Each rngCell In sf.Range("A2:A400")
      
        alan1 = rngCell.Value & rngCell.Offset(0, 1).Value & rngCell.Offset(0, 2).Value
        
    
        For Each sdrange In sd.Range("A2:A400")

            alan2 = sdrange.Value & sdrange.Offset(0, 1).Value & sdrange.Offset(0, 2).Value
            
        
            If alan2 = alan1 Then
                Exit For
            End If
        Next sdrange
        
 
        If alan2 <> alan1 Then
            sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(1, 0).Value = rngCell.Value
            sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(0, 1).Value = rngCell.Offset(0, 1).Value
            sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(0, 2).Value = rngCell.Offset(0, 2).Value
        End If
    Next rngCell
End Sub

 

[muratozmenler]

Karşılaştırma için neyi baz alacağız? Sadece isim olup olmaması mı önemli. Yoksa önceki yılda bulunan değer de önemli mi?
Örnek dosya gönderebilirseniz yardımcı olunabilir.

3 sütunda önemli.

 

[muratozmenler]

Deneyin..

Sub karsilastir2()
    Dim rngCell As Range, sdrange As Range
    Dim sf As Worksheet, sd As Worksheet
    Dim alan1 As String, alan2 As String
  

    Set sf = Sheets("kapanış")
    Set sd = Sheets("Rapor")


    For Each rngCell In sf.Range("A2:A400")
    
        alan1 = rngCell.Value & rngCell.Offset(0, 1).Value & rngCell.Offset(0, 2).Value
      
  
        For Each sdrange In sd.Range("A2:A400")

            alan2 = sdrange.Value & sdrange.Offset(0, 1).Value & sdrange.Offset(0, 2).Value
          
      
            If alan2 = alan1 Then
                Exit For
            End If
        Next sdrange
      

        If alan2 <> alan1 Then
            sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(1, 0).Value = rngCell.Value
            sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(0, 1).Value = rngCell.Offset(0, 1).Value
            sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(0, 2).Value = rngCell.Offset(0, 2).Value
        End If
    Next rngCell
End Sub

Cevabınız için teşekkür ederim fakat Rapor sayfasına veriler alındıkça sayfadaki veride artıyor. For Each sdrange In sd.Range("A2:A400") buradaki sayıyı arttırınca da excel donup kalıyor. Ayrıca sayı artınca da Rapor sayfasında aynı veri olsa bile eklemeye devam ediyor.

 

[sbayyigit]

Sub karsilastir2()
Dim rngCell As Range, sdrange As Range
Dim sf As Worksheet, sd As Worksheet
Dim alan1 As String, alan2 As String


Set sf = Sheets("kapanış")
Set sd = Sheets("Rapor")

son1 = sf.Cells(Rows.Count, "a").End(3).Row
For Each rngCell In sf.Range("A2:A" & son1)

alan1 = rngCell.Value & rngCell.Offset(0, 1).Value & rngCell.Offset(0, 2).Value

son2 = sd.Cells(Rows.Count, "a").End(3).Row
For Each sdrange In sd.Range("A2:A" & son2)

alan2 = sdrange.Value & sdrange.Offset(0, 1).Value & sdrange.Offset(0, 2).Value


If alan2 = alan1 Then
Exit For
End If
Next sdrange


If alan2 <> alan1 Then
sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(1, 0).Value = rngCell.Value
sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(0, 1).Value = rngCell.Offset(0, 1).Value
sd.Range("A" & sd.Rows.Count).End(xlUp).Offset(0, 2).Value = rngCell.Offset(0, 2).Value
End If
Next rngCell
End Sub

 

[muratozmenler]

Çok teşekkür ederim.