Skip to main content

AccessTr.neT


Makro Veya Kod Nasıl Oluştururum

Makro Veya Kod Nasıl Oluştururum

#13
Diğer açtığınız konuyu buraya taşıdım örnek dosyayı.10-Ekim adındaki dosya soru dosyası.
Diğer konu mükerrer olduğu için silinmiştir.
E1 sayfasında E1 den itibaren girilen verilere göre arama yapılıp veriler gelir.

Çözümlerde eklerde.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim bul As Range
   
    With ThisWorkbook.Sheets("T1")
        If Target.Column = 5 And Target.Row >= 3 Then
            If Target.Cells.Count = 1 Then
                Set bul = .Range("E:E").Find(Target.Value, , , 1)
                Target.Offset(, 1).Value = Empty
                If Not bul Is Nothing Then Target.Offset(, 1).Value = bul.Offset(, 1).Value
            End If
        End If
    End With
    Set bul = Nothing
End Sub

Buda dictionary yöntemi ile.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim dict As Object, veri(), i As Long
   
    Set dict = CreateObject("Scripting.dictionary")
    dict.comparemode = 1 '1 kücük büyük harf icin
   
    With ThisWorkbook.Sheets("T1")
        veri = .Range("E1:F" & .Range("E" & Rows.Count).End(3).Row).Value
        If Target.Column = 5 And Target.Row >= 3 Then
            If Target.Cells.Count = 1 Then
                For i = LBound(veri) To UBound(veri)
                    If Not dict.exists(veri(i, 1)) Then dict.Add veri(i, 1), veri(i, 2)
                Next
                Target.Offset(0, 1).Value = dict(Target.Value)
            End If
        End If
    End With
    Set dict = Nothing: Erase veri
End Sub
.rar 10-Ekim.rar (Dosya Boyutu: 10,09 KB | İndirme Sayısı: 1)
.rar 10-Ekim Dictionary ile.rar (Dosya Boyutu: 17,47 KB | İndirme Sayısı: 1)
.rar 10-Ekim Find ile.rar (Dosya Boyutu: 16,91 KB | İndirme Sayısı: 1)
Cevapla
#14
FERAZ BEY SAĞ OLUN. Target.Offset(, 1).Value = Empty 1 5 OLARAK DÜZELTTİM ŞİMDİ OLDU. SİZLERE KOLAY GELSİN
Cevapla
#15
Rica ederim.
Birde yapmışken buton ile yaptım.

[Resim: gggbbc586f09644f8a0.gif]

Private Sub CommandButton1_Click()
    Dim dict As Object, veri(), i As Long, son As Long
    Dim veri2(), k As Long, sonE1 As Long
    Set dict = CreateObject("Scripting.dictionary")
    dict.comparemode = 1 '1 kücük büyük harf icin
   
    With ThisWorkbook.Sheets("T1")
        veri = .Range("E1:F" & .Range("E" & Rows.Count).End(3).Row).Value
        For i = LBound(veri) To UBound(veri)
            If Not dict.exists(veri(i, 1)) Then dict.Add veri(i, 1), veri(i, 2)
        Next
       
        With ThisWorkbook.Sheets("E1")
            sonE1 = .Range("B" & Rows.Count).End(3).Row
            If sonE1 < 3 Then sonE1 = 3
                ReDim veri2(1 To sonE1, 1 To 1)
                For k = 3 To sonE1
                veri2(k - 2, 1) = dict(Cells(k, "E").Value)
            Next
            .Range("F3").Resize(UBound(veri2) - 2, 1).Value = veri2
        End With
       
    End With
    MsgBox "islem tamam", vbInformation, "Bilgi"
    Set dict = Nothing: Erase veri: Erase veri2
End Sub
.rar 10-Ekim buton ile.rar (Dosya Boyutu: 21,98 KB | İndirme Sayısı: 1)
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da