Döngü bitiminde alt hücreyle devam etsin

[kenangulal]

:hey: arkadaşlar aşağıdaki makronun bir alt hücreye devam etmesi için ne yapabilirim. döngüyü tamamladıktan sonra bir alt hücreye geçsin.


Sub yeni()
Var = Range("E3").Value
If Var = Range("B3").Value Then
Range("B4").Select
Range("O3") = Range("B4")

ElseIf Var = "B" Then
Range("O3") = "C"
ElseIf Var = "C" Then
Range("O3") = "D"
ElseIf Var = "D" Then
Range("O3") = "E"
ElseIf Var = "E" Then
Range("O3") = "F"
ElseIf Var = "F" Then
Range("O3") = "G"
ElseIf Var = "G" Then
Range("O3") = "H"
ElseIf Var = "H" Then
Range("O3") = "I"
ElseIf Var = "I" Then
Range("O3") = "J"
ElseIf Var = "J" Then
Range("O3") = "K"
ElseIf Var = "K" Then
Range("O3") = "M"
ElseIf Var = "M" Then
Range("O3") = "N"
ElseIf Var = "N" Then
Range("O3") = "O"
ElseIf Var = "O" Then
Range("O3") = "P"
ElseIf Var = "P" Then
Range("O3") = "R"
ElseIf Var = "R" Then
Range("O3") = "S"
ElseIf Var = "S" Then
Range("O3") = "T"
ElseIf Var = "T" Then
Range("O3") = "V"
ElseIf Var = "V" Then
Range("O3") = "Y"
ElseIf Var = "Y" Then
Range("O3") = "X"
ElseIf Var = "X" Then
Range("O3") = "Z"
ElseIf Var = "Z" Then
Range("O3") = "A"

Else: Var = ""
End If

Range("e3").Activate

End Sub

 

[ALPEN]

Dosyayı ekleme şansınız var mı?

Zira ben döngü göremedim.

 

[kenangulal]

sayın alpen , özür dilerim döngü den kastım ilk hücredeki seçimdi bunu bitirdikten sonra alt hücreye geçmesiydi dosyayı gönderiyorum.

 

[Levent Menteşoğlu]

Verdiğiniz kodu incelediğimde şunu anlıyorum, E sütunundaki değerlere sırası ile bakılacak ve O sütununa E sütunundaki harfin alfabetik olarak bir sonraki harfi yazılacak. Eğer böyle ise arada bazı harfler atlanmış gibi görünüyor. Ã?rneğin "L";"Q";"U" yok, ayrıcada "X" in sırasıda hatalı. Kriterler yukarıda belirttiğim şekildemi olacak?

 

[kenangulal]

doğru söylüyorsunuz kriterlerin sırası şu an için önemli değildi çalışma uzun süreceği için belli harfler kullandım e sutunundaki sırasıyla bakma işlemi o sutunu için de geçerli e3 'e bakarak o3 hücresini değiştirdikten sonra her iki tarafta alt hücrede aynı işlemi yapacak ve sırasıyla aşağıya inecek. teşekkür ederim.

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:5143bbc4e9]Sub ac()
ara = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
For a = 3 To [d65536].End(3).Row
For b = 0 To 25
If Cells(a, "e") = "Z" Then
Cells(a, "o") = ara(0)
GoTo 10
End If
If Cells(a, "e") = ara(b) Then Cells(a, "o") = ara(b + 1)
10 Next: Next
End Sub
[/vb:1:5143bbc4e9]

 

[kenangulal]

:dua: Çok teşekkür ederim sayın leventm harika olmuş aklınıza sağlık
saygılar.