• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kodların açıklaması

numan şamil

Destek Ekibi
Destek Ekibi
Katılım
27 Ocak 2011
Mesajlar
1,238
Excel Vers. ve Dili
Ofis 2013 Türkçe
Merhabalar
Forumdan aldığımaşağıdaki kodların açıklamasını satır satır yapabilirmisiniz
(Öğrenmek amacı ile üzerinde çalışıyorumda)

Sub Emre()
Dim bul As Range
Dim i As Integer
For Each bul In Range("B2:B27")
For i = 8 To 18
If bul.Value = Range("G2").Value And bul.Offset(0, 1).Value = Cells(1, i) Then
Cells(2, i) = bul.Offset(0, 2).Value
End If
If bul.Value = Range("G3").Value And bul.Offset(0, 1).Value = Cells(1, i) Then
Cells(3, i) = bul.Offset(0, 2).Value
End If
If bul.Value = Range("G4").Value And bul.Offset(0, 1).Value = Cells(1, i) Then
Cells(4, i) = bul.Offset(0, 2).Value
End If: Next i: Next bul: i = Empty: Set bul = Nothing
End Sub
Anladığım kadarıyla "For i = 8 To 18" kodların düzenine göre "H:R" sutunu arasına yazdırıyor
Bunu örn:"F2:F20" alt alta yazdıracak olursakkodların neresini revize etmemiz gerekiyor
 
Son düzenleme:
Merhaba Numan Bey, özelden mesaj atmayınız lütfen.
Yanlış anlamayın ama hem sevmiyorum, hem de mesaj kutumda sadece 15 mesaj saklayabiliyorum ve gelen mesajlardan dolayı sürekli boşaltmak zorunda kalıyorum.

Ayrıca bu kodların açıklaması için yeni bir konu açmanıza gerek yoktu, aynı konu altına yazabilirdiniz...

Anlayışınız için teşekkür ederim.

Şimdi kodları satır satır izah etmeye çalışayım:

Kod:
[SIZE="2"]Sub Emre()
[COLOR="Blue"]Makronun (prosedür) adı[/COLOR]
Dim bul As Range
[COLOR="Blue"]bul adında bir hücre değişkeni atanıyor[/COLOR]
Dim i As Integer
[COLOR="blue"]i adında sayısal bir değişken atanıyor[/COLOR]
For Each bul In Range("B2:B27")
[COLOR="blue"]for each döngüsü ile bul adındaki hücre değişkeninin aralığı belirtiliyor[/COLOR]
For i = 8 To 18
[COLOR="blue"]for döngüsü ile i sayısal değişkeninin 8 ile 18 arasında olduğu belirtiliyor[/COLOR]
If bul.Value = Range("G2").Value And bul.Offset(0, 1).Value = Cells(1, i) Then
[COLOR="blue"]eğer bul'un değeri G2 hücresindeki değere eşitse
ve bul'un olduğu sütunun bir sağındaki sütun, 1. satır ile i değişkeni aralığına eşitse[/COLOR]
Cells(2, i) = bul.Offset(0, 2).Value
[COLOR="blue"]2.satır ile i değişkeni arasındaki değer eşittir bul değişkeninin 2 sütun sağındaki değer[/COLOR]
End If
[COLOR="blue"]If ile başlayan şart sonlandırılıyor[/COLOR]
If bul.Value = Range("G3").Value And bul.Offset(0, 1).Value = Cells(1, i) Then
[COLOR="blue"]eğer bul'un değeri G3 hücresindeki değere eşitse
ve bul'un olduğu sütunun bir sağındaki sütun, 1. satır ile i değişkeni aralığına eşitse[/COLOR]
Cells(3, i) = bul.Offset(0, 2).Value
[COLOR="blue"]3.satır ile i değişkeni arasındaki değer eşittir bul değişkeninin 2 sütun sağındaki değer[/COLOR]
End If
[COLOR="blue"]If ile başlayan şart sonlandırılıyor[/COLOR]
If bul.Value = Range("G4").Value And bul.Offset(0, 1).Value = Cells(1, i) Then
[COLOR="blue"]eğer bul'un değeri G4 hücresindeki değere eşitse
ve bul'un olduğu sütunun bir sağındaki sütun, 1. satır ile i değişkeni aralığına eşitse[/COLOR]
Cells(4, i) = bul.Offset(0, 2).Value
[COLOR="blue"]4.satır ile i değişkeni arasındaki değer eşittir bul değişkeninin 2 sütun sağındaki değer[/COLOR]
End If
[COLOR="blue"]If ile başlayan şart sonlandırılıyor[/COLOR]
Next i
[COLOR="blue"]for i döngüsünden çıkılıyor[/COLOR]
Next bul
[COLOR="blue"]bul adındaki for each döngüsünden çıkılıyor[/COLOR]
i = Empty
[COLOR="blue"]i değişkeninin içi boşaltılıyor[/COLOR]
Set bul = Nothing
[COLOR="blue"]bul değişkeninin içi boşaltlıyor[/COLOR]
End Sub
[COLOR="blue"]makronun sonu (prosedür sonlandırılıyor)[/COLOR][/SIZE]
 
Merhab Murat bey
Kodlarınızı daha önce arşifime almıştım o yüzden yeni konu açtım
Kusura bakmayın kodlar sizin olduğu için sizin açıklamanız daha uygun olur diye özel masj attım
Açıklamalar için çok teşekkür ederim
Belki yeni konu açmam gerekiyor ama hazır sizi bulmuşken affınıza sığınarak bir soru daha sorayım
Ekli dosyayı inceleyebilirmisiniz
 

Ekli dosyalar

Soruyu anlamadım...
 
Sorum kısaca şu
3. mesajda ekli dosyada örn:sayfa2 de "A2" hücresinde bulunan (148) değeri sayfa1"A" sutununda arayıp bulacak ve hemen sağındaki hücrede bulunan (kiraz) değeri sayfa2 de yerine yazacak böylce işlem bitene kadar devam edecek
 
Şimdi anladım.
Aşağıdaki kodlar işinizi görecektir...

Kod:
[SIZE="2"]Sub Emre()
    Dim i As Integer
    Dim bul As Range
    For Each bul In Sayfa2.Range("A2:A100")
    For i = 2 To 100
    If bul.Value = Sayfa1.Cells(i, 1) Then
    bul.Offset(0, 2).Value = Sayfa1.Cells(i, 3)
    End If: Next i: Next bul: Set bul = Nothing: i = Empty
End Sub[/SIZE]
 
Şimdi anladım.
Aşağıdaki kodlar işinizi görecektir...

Kod:
[SIZE="2"]Sub Emre()
    Dim i As Integer
    Dim bul As Range
    For Each bul In Sayfa2.Range("A2:A100")
    For i = 2 To 100
    If bul.Value = Sayfa1.Cells(i, 1) Then
    bul.Offset(0, 2).Value = Sayfa1.Cells(i, 3)
    End If: Next i: Next bul: Set bul = Nothing: i = Empty
End Sub[/SIZE]

Merhaba Murat bey
kodlarınıza şu şekilde bir ekleme yaptım
Sub Emre()
Dim i As Integer
Dim bul As Range
For Each bul In Sayfa2.Range("A2:A100")
For i = 2 To 100
If bul.Value = Sayfa1.Cells(i, 1) Then
bul.Offset(0, 1).Value = Sayfa1.Cells(i, 2)
If bul.Value = Sayfa1.Cells(i, 1) Then
bul.Offset(0, 2).Value = Sayfa1.Cells(i, 3)
End If
End If: Next i: Next bul: Set bul = Nothing: i = Empty
End Sub

Yukarıdaki işleme ek olarak Sayfa1de "d" sutununda yaptırıp ekli dosyada sayfa2 deyeşil boyalı yerlere manuel girdiğim verileride getirmek için kodlara negibi ekleme yapmalıyız
 

Ekli dosyalar

Merhaba Murat bey
Kodlarda aşağıdaki gibi eklemeler yaptım
istediklerim oldu.Yalnız biraz yavaş çalışıyor
Daha hızlı çalışması için ne yapılabilinir.
inceleyebilirmisiniz bir eksiklik var mı?
Sub Emre()
Dim i As Integer
Dim bul As Range
For Each bul In Sayfa2.Range("A2:A100")
For i = 2 To 100
If bul.Value = Sayfa1.Cells(i, 1) Then
bul.Offset(0, 1).Value = Sayfa1.Cells(i, 2)
bul.Offset(0, 2).Value = Sayfa1.Cells(i, 3)
End If
If bul.Value = Sayfa1.Cells(i, 4) Then
bul.Offset(0, 3).Value = Sayfa1.Cells(i, 5)
bul.Offset(0, 4).Value = Sayfa1.Cells(i, 6)
End If: Next i: Next bul: Set bul = Nothing: i = Empty
End Sub
 

Ekli dosyalar

Geri
Üst