Soru Makro'ya Özellik Ekleme

M

MindLove

Katılım
6 Ağustos 2022
Mesajlar
21
Excel Vers. ve Dili
2021
Makro:
Kod: 
Option Explicit

Sub Fast_Vlookup()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim Veri As Variant, X As Long
    Dim Zaman As Double, Say As Long
   
    Zaman = Timer
   
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
   
    Veri = S1.Range("A1").CurrentRegion.Value
   
    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            .Item(Veri(X, 1)) = Veri(X, 2)
        Next
   
        Veri = S2.Range("A2:A" & S2.Cells(S2.Rows.Count, 1).End(3).Row).Value
       
        ReDim Liste(1 To S2.Rows.Count, 1 To 1)
       
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            Say = Say + 1
            If .Exists(Veri(X, 1)) Then
                Liste(Say, 1) = .Item(Veri(X, 1))
            End If
        Next
        S2.Range("B2").Resize(Say).Value = Liste
    End With
   
    Set S1 = Nothing
    Set S2 = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Sayfa 1 ve 2


Makro Çalışınca Sonuç Sayfa 2 Sonuç


Sayfa 2 Asıl Kaynağım
Benim Sayfa lardaki A ID ler Karşılaşıp B İçeriği İle Değişiyor Sorun Yok
Ama Sayfa 2 deki Bulamadığı ID ve İçeriği Silmek Yerine ID ve İçeriği Sayfa 3 Yazsın 2 'den Silsin İstiyorum
Yardımcı Olurmusunuz
 
ÖmerFaruk

ÖmerFaruk

Destek Ekibi
Destek Ekibi
Katılım
22 Ekim 2017
Mesajlar
4,779
Excel Vers. ve Dili
Microsoft 365 Tr-64
Dosyanız olmadığı için kendim veri oluşturup denedim
Mevcut kodunuz üzerinde revizyon yaptım
C++: 
Sub Fast_Vlookup()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Veri As Variant, X As Long
    Dim Zaman As Double, Say1 As Long, Say2 As Long
  
    Zaman = Timer
  
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    Veri = S1.Range("A1").CurrentRegion.Value
  
    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            .Item(Veri(X, 1)) = Veri(X, 2)
        Next
        Veri = S2.Range("A2:B" & S2.Cells(S2.Rows.Count, 1).End(3).Row).Value
        ReDim Liste1(1 To S2.Rows.Count, 1 To 2)
        ReDim Liste2(1 To S2.Rows.Count, 1 To 2)
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If .Exists(Veri(X, 1)) Then
                Say1 = Say1 + 1
                Liste1(Say1, 1) = Veri(X, 1)
                Liste1(Say1, 2) = .Item(Veri(X, 1))
            Else
                Say2 = Say2 + 1
                Liste2(Say2, 1) = Veri(X, 1)
                Liste2(Say2, 2) = Veri(X, 2)
            End If
        Next
        S2.Range("A2:B" & Rows.Count).ClearContents
        S3.Range("A2:B" & Rows.Count).ClearContents
        S2.Range("A2").Resize(Say1, 2).Value = Liste1
        S3.Range("A2").Resize(Say2, 2).Value = Liste2
    End With
  
    Set S1 = Nothing: Set S2 = Nothing: Set S3 = Nothing
    Erase Veri: Erase Liste1: Erase Liste2
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
M

MindLove

Katılım
6 Ağustos 2022
Mesajlar
21
Excel Vers. ve Dili
2021
ÖmerFaruk' Alıntı:
Dosyanız olmadığı için kendim veri oluşturup denedim
Mevcut kodunuz üzerinde revizyon yaptım
C++: 
Sub Fast_Vlookup()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Veri As Variant, X As Long
    Dim Zaman As Double, Say1 As Long, Say2 As Long
 
    Zaman = Timer
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    Veri = S1.Range("A1").CurrentRegion.Value
 
    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            .Item(Veri(X, 1)) = Veri(X, 2)
        Next
        Veri = S2.Range("A2:B" & S2.Cells(S2.Rows.Count, 1).End(3).Row).Value
        ReDim Liste1(1 To S2.Rows.Count, 1 To 2)
        ReDim Liste2(1 To S2.Rows.Count, 1 To 2)
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If .Exists(Veri(X, 1)) Then
                Say1 = Say1 + 1
                Liste1(Say1, 1) = Veri(X, 1)
                Liste1(Say1, 2) = .Item(Veri(X, 1))
            Else
                Say2 = Say2 + 1
                Liste2(Say2, 1) = Veri(X, 1)
                Liste2(Say2, 2) = Veri(X, 2)
            End If
        Next
        S2.Range("A2:B" & Rows.Count).ClearContents
        S3.Range("A2:B" & Rows.Count).ClearContents
        S2.Range("A2").Resize(Say1, 2).Value = Liste1
        S3.Range("A2").Resize(Say2, 2).Value = Liste2
    End With
 
    Set S1 = Nothing: Set S2 = Nothing: Set S3 = Nothing
    Erase Veri: Erase Liste1: Erase Liste2
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Genişletmek için tıkla ...
Çok teşekkür ediyorum hocam
 
M

MindLove

Katılım
6 Ağustos 2022
Mesajlar
21
Excel Vers. ve Dili
2021
ÖmerFaruk' Alıntı:
Dosyanız olmadığı için kendim veri oluşturup denedim
Mevcut kodunuz üzerinde revizyon yaptım
C++: 
Sub Fast_Vlookup()
    Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
    Dim Veri As Variant, X As Long
    Dim Zaman As Double, Say1 As Long, Say2 As Long
 
    Zaman = Timer
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
    Set S3 = Sheets("Sayfa3")
    Veri = S1.Range("A1").CurrentRegion.Value
 
    With VBA.CreateObject("Scripting.Dictionary")
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            .Item(Veri(X, 1)) = Veri(X, 2)
        Next
        Veri = S2.Range("A2:B" & S2.Cells(S2.Rows.Count, 1).End(3).Row).Value
        ReDim Liste1(1 To S2.Rows.Count, 1 To 2)
        ReDim Liste2(1 To S2.Rows.Count, 1 To 2)
        For X = LBound(Veri, 1) To UBound(Veri, 1)
            If .Exists(Veri(X, 1)) Then
                Say1 = Say1 + 1
                Liste1(Say1, 1) = Veri(X, 1)
                Liste1(Say1, 2) = .Item(Veri(X, 1))
            Else
                Say2 = Say2 + 1
                Liste2(Say2, 1) = Veri(X, 1)
                Liste2(Say2, 2) = Veri(X, 2)
            End If
        Next
        S2.Range("A2:B" & Rows.Count).ClearContents
        S3.Range("A2:B" & Rows.Count).ClearContents
        S2.Range("A2").Resize(Say1, 2).Value = Liste1
        S3.Range("A2").Resize(Say2, 2).Value = Liste2
    End With
 
    Set S1 = Nothing: Set S2 = Nothing: Set S3 = Nothing
    Erase Veri: Erase Liste1: Erase Liste2
    MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & vbCrLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Genişletmek için tıkla ...
Hocam Çok Yardımcı Oldunuz Ufak Bir Yapılandırma Talepde Bulunabilirmiyim

B,C,D,E,F,G tüm sıra Sayfa 2 'den Silip Yazdırabilirmiyiz

Sayfa1 A:2 karşılaşıp Sayfa2 A:2
Sayfa1 B,C,D,E,F,G.... Sayfa2 'ye Aktarıp Sayfa2'de Olmayan A 'lar yine Sayfa3 'de listelenecek şekilde
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst