döngüyü kuramadım

[udentr2002]

Merhaba arkadaşlar;

Benim "Etiket" adlı bir sayfam var. Bu sayfada bir butona tıkladığımda aşağıda örnek olarak belşirttiğim hücrelerdeki bilgiyi karşısındakiş hücreye yazacak bu şekilde I2 stünunu baz alırsanız 1000 den fazla satırım var bunun için nasıl bir döngü kurabilirim. Yardımcı olursanız sevinirim.


I2=D2
J2=D3
K2=D4
L2=D5
M2=D6
N2=B8


I3=D13
J3=D14
K3=D15
L3=D16
M3=D17
N3=B19

I4=D24
J4=D25
K4=D26
L4=D27
M4=D28
N4=D30

"" ""
"" ""
"" ""

 

[Orion1]

Aşağıdaki kodu deneyiniz.

Sub dongu_59()
Dim i As Long, j As Long, sat As Long, sat2 As Long
Dim sut As Byte
sat2 = 2
Application.ScreenUpdating = False
For i = 2 To 1002   
    For sut = 9 To 13
        Cells(i, sut).Value = Cells(sat2, "D").Value
        sat2 = sat2 + 1
    Next sut
    sat = sat2 + 1
    Cells(i, 14).Value = Cells(sat2, "B").Value
    sat2 = sat2 + 5
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

 

[Orion1]

sat konusunda bir düzeltme yaptım.
Tekrar deneyiniz.

 

[udentr2002]

Hocam siteye giremedim hata veriyordu o yüzden cevbaım gecikti

Hocam ellerinize ve emeğinize sağlık.
Yanlız ben bir hata yapmışım ya aslında olması gereken sıralama şöyle çok ama çok özür dilerim hocam gözümden kaçmış benimde

D2=I2
D3=J2
D4=K2
D5=L2
D6=M2
B8=N2

G2=I3
G3=J3
G4=K3
G5=L3
G6=M3
E8=N3


D13=I4
D14=J4
D15=K4
D16=L4
D17=M4
B19=N4

G13=I5
G14=J5
G15=K5
G16=L5
G17=M5
E18=N5

Şeklinde devam etmeli hocam. Tekrar bakabilirseniz inanın çok sevinirim.

SAYGILARIMLA

 

[Orion1]

Hocam siteye giremedim hata veriyordu o yüzden cevbaım gecikti

Hocam ellerinize ve emeğinize sağlık.
Yanlız ben bir hata yapmışım ya aslında olması gereken sıralama şöyle çok ama çok özür dilerim hocam gözümden kaçmış benimde

Şeklinde devam etmeli hocam. Tekrar bakabilirseniz inanın çok sevinirim.

SAYGILARIMLA

Ben bu soruyu yaptım,geçtim.Bu soru benim için kapandı.
Başka arkadaşlardan yardım alabilirisniz.

 

[udentr2002]

Hocam aslında soruya cevapo gelmeden önce düzeltmek istedim sorumu ama sürekli aşırı sunucu yüklenmesi 1 dakika kadar sonra tekrar deneyiniz yazıp duruyordu. Ama haklısınız. Yinede emek verip zaman ayırdığınız için gerçekten tüm samimiyetimle teşekkür ederim Hakkınızı helal edin. İnşallah başka bir arkadaşım yardımcı olur.

 

[Orion1]

Hocam aslında soruya cevapo gelmeden önce düzeltmek istedim sorumu ama sürekli aşırı sunucu yüklenmesi 1 dakika kadar sonra tekrar deneyiniz yazıp duruyordu. Ama haklısınız. Yinede emek verip zaman ayırdığınız için gerçekten tüm samimiyetimle teşekkür ederim Hakkınızı helal edin. İnşallah başka bir arkadaşım yardımcı olur.

Bende sonradan yaptım ama server meşgul olduğundan cevabı ekleyemedim.
Aşağıdaki kodları deneyiniz.

Dim i As Long, j As Long, sat As Long, sat2 As Long
Dim sut As Byte
sat2 = 2
Application.ScreenUpdating = False
For i = 2 To 1002 Step 2
    For sut = 9 To 13
        Cells(sat2, "D").Value = Cells(i, sut).Value
        Cells(sat2, "G").Value = Cells(i + 1, sut).Value
        sat2 = sat2 + 1
    Next sut
    sat = sat2 + 1
    Cells(sat2, "B").Value = Cells(i, "N").Value
    Cells(sat2, "E").Value = Cells(i + 1, "N").Value
    sat2 = sat2 + 5
Next i
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"

 

[udentr2002]

Hocam çok ama çok teşekkür ederim. Ellerinize emeğinize sağlık.
Allah razı olsun. tam istediğim gibi olmuş.

 

[Orion1]

Hocam çok ama çok teşekkür ederim. Ellerinize emeğinize sağlık.
Allah razı olsun. tam istediğim gibi olmuş.

Rica ederim.
İyi çalışmalar.