Alta alta sıralanmış verileri diğer bir sheette belli satırlara yazdırmak

[u.L.a.s]

Merhabalar

Sheet2 de aşağıdaki gibi standart bir düzenek var. 25 satırlık bir komut düzeneği bu. 25 satırda bir aslında hep aynı komut var. sadece 3-4-19. satırları sheet1 den sıra ile çekip getirmek gerekiyor.




Sheet1 dede 2 sütundan oluşan veri düzeneğim var.



Benim istediğim şu.
Sheet1 de 2. satırdan itibaren Sheet2 ye belirttiğim 3-4-19. satırlara yazdırmak gerekiyor. tabi 2. satırı 3.4.19. satıra atacak. 3. satırı 2.25lik komut düzeneğinde 28.29.44. satırlara atması gerekiyor. 4. satırı takip eden 53.54.69. satırlara yazacak ve sheet1 deki liste tamamlanıncaya kadar sheet2 de komut düzeneğine bu verileri aktaracak.

Burada dikkat edilmesi gereken Sheet1 deki 1. satır Sheet2 de ilk 25 lik komut düzeneğinde 3.4.19. satırlara gidiyor. dolayısıyla Sheet1 deki 2. satır sheet2 deki 2. 25 lik komut düzeneğinde 3+25=28. satır --- 4+25=29.satır --- 19+25=44. satıra yazacak.

yani 3.4.19 sheet1 deki her satır için sheet2 25 artarak atacak kendini.

dikkat edilmesi gereken diğer bir husus ise
3. satırdaki veri "Title = 2-xyz" şeklinde yani sheet1 deki ilk satırda bulunan şube kodu sütunundaki ilk veri var. ama başında "Title = " veriside var. yani sheet2 de 3. satıra veriyi getirirken başına "Title = " verisini ekleyip yazmalı.

aynı şekilde 4. satırda "Comment = 10.10.10.1" verisi mevcut. bu veriyide sheet1 deki ilk satırda bulunan ip sütunu altındaki 10.10.10.1 verisi var fakat başında "Comment = "veriside var. yani 10.10.10.1 in başına "Comment = " verisini yazarak atmalı.

aynı şekilde 19. satırda "Host = 10.10.10.1" verisi var. yine sheet1 deki ip sütunu altındaki 10.10.10.1 verisi var burdada ve başında "Host = " verisi var.

yani 3.4.19. satırlar ve bu satırlara her 25 satır da verileri getirirken başlarına tırnak işareti içerisindeki yazdığım verilerle beraber yazmalı.

Örnek gönderdiğim dosyada sheet1 de 11 satırlık bir veri var tabi ama asıl dosyam 2000 falan.

sheet2 de ise örnek olsun diye 25 lik kod düzeneğini 3 tane 25 halinde koydum. tabi burasınıda sheet1 deki 2000 tane 25 olarak koymam gerekiyor.

eğer sheet1 deki satır sayısı kadar sheet2 deki 25 satırlık kod düzeneğinide otomatik satır sayısı kadar yazddırabilirsek ayrıca sevinirim.

Çok teşekkürler şimdiden.

örnek excel dosyayı bu linkten indirebilirsiniz.
http://s3.dosya.tc/server3/cr9vfi/Book1.rar.html

 

[Emir Hüseyin Çoban]

. . .

Sayfa2 nin hiç değişiklik yapılmamış halinin örneğini yükleyebilir misiniz.

. . .

 

[veyselemre]

Merhaba, aşağıdaki kodları deneyiniz.

Sub aktar()
    Dim ek(1 To 3) As String
    ek(1) = "Title       = "
    ek(2) = "Comment     = "
    ek(3) = "Host        = "
    Set sH1 = Sheets("Sheet1")
    Set sH2 = Sheets("Sheet2")

    sonS1 = sH1.Range("a" & Rows.Count).End(3).Row
    For i = 2 To sonS1
        sH2.Cells((i - 2) * 25 + 3, 1) = ek(1) & sH1.Cells(i, 1)
        sH2.Cells((i - 2) * 25 + 4, 1) = ek(2) & sH1.Cells(i, 2)
        sH2.Cells((i - 2) * 25 + 19, 1) = ek(3) & sH1.Cells(i, 2)
    Next i
    Set sH1 = Nothing: Set sH2 = Nothing
End Sub

 

[u.L.a.s]

emeğinize bilginize sağlık çok güzel olmuş

peki şu son sorduğum bişey vardı.

Sheet2 de bulunan bu 25 satırlık kod parçası

bu kod parçası aşağıda.

Benim sheet1 de alt alta 997 tane satır verim var.

Sheet2 de 997 tane bu 25 lik satırdan alt alta oluştrabilir miyiz.

Çok teşekkürler tekrardan

Method      = Ping
;DestFolder = xxx\xxx
Title       = 2-xyz
Comment     = 10.10.10.1
RelatedURL  = 
CmntPattern = Ping %host%
ScheduleMode= Regular
Schedule    = 
Interval    = 600
Alerts      = 
Alerts2     = 
ReverseAlert= No
UnknownIsBad= Yes
WarningIsBad= Yes
UseCommonLog= Yes
PrivLogMode = Default
CommLogMode = Default
;--- Test specific properties ---
Host        = 10.10.10.1
Timeout     = 2000
Retries     = 4
MaxLostRatio= 100
DisplayMode = time
DontFragment= No

 

[veyselemre]

Sub aktar()
    ek3 = "Title       = "
    ek4 = "Comment     = "
    ek19 = "Host        = "
    
    Dim ek(1 To 24) As String
    
    ek(1) = "Method      = Ping"
    ek(2) = ";DestFolder = xxx\xxx"
    ek(5) = "RelatedURL  = "
    ek(6) = "CmntPattern = Ping %host%"
    ek(7) = "ScheduleMode= Regular"
    ek(8) = "Schedule    = "
    ek(9) = "Interval    = 600"
    ek(10) = "Alerts      = "
    ek(11) = "Alerts2     = "
    ek(12) = "ReverseAlert= No"
    ek(13) = "UnknownIsBad= Yes"
    ek(14) = "WarningIsBad= Yes"
    ek(15) = "UseCommonLog= Yes"
    ek(16) = "PrivLogMode = Default"
    ek(17) = "CommLogMode = Default"
    ek(18) = ";--- Test specific properties ---"
    ek(20) = "Timeout     = 2000"
    ek(21) = "Retries     = 4"
    ek(22) = "MaxLostRatio= 100"
    ek(23) = "DisplayMode = time"
    ek(24) = "DontFragment= No"

    Set sH1 = Sheets("Sheet1")
    Set sH2 = Sheets("Sheet2")

    For i = 2 To sH1.Range("a" & Rows.Count).End(3).Row
        ek(3) = ek3 & sH1.Cells(i, 1)
        ek(4) = ek4 & sH1.Cells(i, 2)
        ek(19) = ek19 & sH1.Cells(i, 2)
        For ii = 1 To 24
            sH2.Cells((i - 2) * 25 + ii, 1).Value = ek(ii)
        Next ii
    Next i
    Set sH1 = Nothing: Set sH2 = Nothing
End Sub

 

[u.L.a.s]

Üstadım emeğine bilgine sağlık çok teşekkürler