Sayısal verileri karşılaştırma

[metin_0606]

A ve B sütunlarında ki sayısal verileri karşılaştırıp aynı olanlari G sütununa yazdırmak istiyorum. Yardımlarınız için şimdiden teşekkürler

 

[Muzaffer Ali]

Merhaba.

Sub test()
    Dim Bak As Integer
    For Bak = 1 To Cells(Rows.Count, "A").End(xlUp).Row
         If Cells(Bak, "A") = Cells(Bak, "B") Then Cells(Bak, "G") = Cells(Bak, "A")
    Next
End Sub

 

[metin_0606]

Merhaba.

Sub test()
    Dim Bak As Integer
    For Bak = 1 To Cells(Rows.Count, "A").End(xlUp).Row
         If Cells(Bak, "A") = Cells(Bak, "B") Then Cells(Bak, "G") = Cells(Bak, "A")
    Next
End Sub

Sayın dalgalikur benzer veriler aynı satirda olursa buluyor ancak farklı satır larda olursa bulmuyor

 

[Muzaffer Ali]

Örneğin; A5 hücresinde 10, B25 hücresinde de 10 yazıyorsa G sütununda hangi satıra ne yazmak istiyorsunuz?

 

[metin_0606]

Örneğin; A5 hücresinde 10, B25 hücresinde de 10 yazıyorsa G sütununda hangi satıra ne yazmak istiyorsunuz?

10 yazmak istiyorum

 

[metin_0606]

Örneğin; A5 hücresinde 10, B25 hücresinde de 10 yazıyorsa G sütununda hangi satıra ne yazmak istiyorsunuz?

Yani A ve B sutunundaki benzerleri G sütununda listelesin istiyorum Benzerlerin bulunduğu satırlar farklı olabilir

 

[Muzaffer Ali]

Deneyin.

Sub test()
    Dim Bak As Integer
    Dim Bul As Range
    For Bak = 1 To Cells(Rows.Count, "A").End(xlUp).Row
         Set Bul = Range("A:A").Find(Cells(Bak, "B"), lookat:=xlWhole)
         If Not Bul Is Nothing Then
            If Not Bul.Text = "" Then Cells(Cells(Rows.Count, "G").End(xlUp).Row + 1, "G") = Bul.Text
         End If
    Next
End Sub

 

[metin_0606]

Deneyin.

Sub test()
    Dim Bak As Integer
    Dim Bul As Range
    For Bak = 1 To Cells(Rows.Count, "A").End(xlUp).Row
         Set Bul = Range("A:A").Find(Cells(Bak, "B"), lookat:=xlWhole)
         If Not Bul Is Nothing Then
            If Not Bul.Text = "" Then Cells(Cells(Rows.Count, "G").End(xlUp).Row + 1, "G") = Bul.Text
         End If
    Next
End Sub

Teşekkürler sayın dalgalikur

 

[Muzaffer Ali]

Rica ederim. Kolay gelsin.

 

[Korhan Ayhan]

Alternatif;

Doğru sorguyu yazdığıma emin olamadım. Deneyip sonucu bildirir misiniz?

Option Explicit

Sub Ortak_Olanlari_Listele()
    Dim Dosya As String, Baglanti As Object, Kayit_Seti As Object
    Dim Sorgu As String, S1 As Worksheet, Zaman As Double
  
    Zaman = Timer
  
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
  
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    Set S1 = Sheets("Sayfa1")
  
    Dosya = ThisWorkbook.FullName
  
    S1.Range("G:G").Clear
    S1.Range("G1") = "Ortak Olanlar"
    S1.Range("G1").Font.Bold = True
  
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
      
    Sorgu = "Select Distinct SütunA.[Başlık1] " & _
            "From [Sayfa1$] As SütunA " & _
            "Left Join [Sayfa1$] As SütunB " & _
            "On SütunA.[Başlık1] = SütunB.[Başlık2] " & _
            "Where SütunA.[Başlık1] = SütunB.[Başlık2] " & _
            "Order By SütunA.[Başlık1] Asc"
  
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    If Kayit_Seti.RecordCount > 0 Then
        S1.Range("G2").CopyFromRecordset Kayit_Seti
        S1.Columns.AutoFit
    End If
  
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close
  
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    Set S1 = Nothing
          
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
  
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub