• DİKKAT

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

Makroyla belirli aralıktaki verileri başka sayfaya kopyalama

Katılım
29 Aralık 2005
Mesajlar
862
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba
Yapmak istediğimi kısaca anlatayım.
Elimde ham verileri aldığım "Data" sayfam var. Bu veriler toplam 3 sütundan oluşuyor. C sütunundaki verilerden istatistik çalışma yapmam lazım. C sütunundaki verilerde her 50 parçadan 5 parçanın değerini "Değerlendirme" sayfasındaki formata kopyalamam lazım. Yani ilk 5 parçanın değerini "Değerlendirme" sayfasına aldım ve 1.frekans değeri olarak kaydettim. Daha sonra bu parçaların üstüne 50 daha sayıp (yani 55.parçadan itibaren başlayacak yeni frekans) diğer 5 değeri "Değerlendirme" sayfasına kopyalayacağım. Bu 2.frekans satırı olacak ve böyle devam edecek.

Dosya yükleyemediğim için link veriyorum, kusura bakmayın. Yardımcı olabilirseniz sevinirim.

https://dl.dropboxusercontent.com/u/76147868/Soru.rar
 
Aşağıdaki kodu deneyin.

Kod:
Sub Istatistik()
    Dim Bak As Integer
    Dim SatirSayData As Integer
    Dim SatirSayDeg As Integer
    SatirSayData = Worksheets("Data").Cells(Rows.Count, "A").End(3).Row
    For Bak = 2 To SatirSayData Step 55
        With Worksheets("Değerlendirme")
            SatirSayDeg = .Cells(Rows.Count, "A").End(3).Row + 1
            .Cells(SatirSayDeg, 1) = SatirSayDeg - 1
            .Cells(SatirSayDeg, 2) = Worksheets("Data").Cells(Bak, 2)
            .Cells(SatirSayDeg, 3) = Worksheets("Data").Cells(Bak, 3)
            .Cells(SatirSayDeg, 4) = Worksheets("Data").Cells(Bak + 1, 3)
            .Cells(SatirSayDeg, 5) = Worksheets("Data").Cells(Bak + 2, 3)
            .Cells(SatirSayDeg, 6) = Worksheets("Data").Cells(Bak + 3, 3)
            .Cells(SatirSayDeg, 7) = Worksheets("Data").Cells(Bak + 4, 3)
        End With
    Next
End Sub
 
Kod:
Sub test()
    veri = Sheets("Data").Range("B2:C" & Sheets("Data").Cells(Rows.Count, 2).End(3).Row).Value
    For i = 1 To UBound(veri) Step 54
        tar = ""
        For ii = 0 To 4
            If tar <> veri(i + ii, 1) Then
                sat = sat + 1
                tar = veri(i + ii, 1)
                Sheets("Değerlendirme").Cells(sat + 1, 1) = sat
                Sheets("Değerlendirme").Cells(sat + 1, 2) = tar
            End If
            Sheets("Değerlendirme").Cells(sat + 1, ii + 3) = veri(i + ii, 2)
        Next ii
    Next i
End Sub
 
Aşağıdaki kodu deneyin.

Kod:
Sub Istatistik()
    Dim Bak As Integer
    Dim SatirSayData As Integer
    Dim SatirSayDeg As Integer
    SatirSayData = Worksheets("Data").Cells(Rows.Count, "A").End(3).Row
    For Bak = 2 To SatirSayData Step 55
        With Worksheets("Değerlendirme")
            SatirSayDeg = .Cells(Rows.Count, "A").End(3).Row + 1
            .Cells(SatirSayDeg, 1) = SatirSayDeg - 1
            .Cells(SatirSayDeg, 2) = Worksheets("Data").Cells(Bak, 2)
            .Cells(SatirSayDeg, 3) = Worksheets("Data").Cells(Bak, 3)
            .Cells(SatirSayDeg, 4) = Worksheets("Data").Cells(Bak + 1, 3)
            .Cells(SatirSayDeg, 5) = Worksheets("Data").Cells(Bak + 2, 3)
            .Cells(SatirSayDeg, 6) = Worksheets("Data").Cells(Bak + 3, 3)
            .Cells(SatirSayDeg, 7) = Worksheets("Data").Cells(Bak + 4, 3)
        End With
    Next
End Sub
Merhaba Sayın Veyselemre

Öncelikle yazdığınız kod için çok teşekkür ederim.

Yazdığınız iki kodu da uyguladım. İstatistik kodunda ölçüm frekansını değiştirmek istersem ne yapmalıyım? Her parça için 50 parçada 5 parça olmuyor. Bunun için kriterleri Data sayfasındaki E2 ve F2 hücrelerine nasıl bağlarım? Birde kodun verilerin sonuna geldiğinde durması lazım. Yoksa aynı verileri alt alta yazmaya devam ediyor.

Test kodu neyi test ediyor? Bunu anlayamadım.

Başınızı ağrıttıysam kusura bakmayın. İlginiz için tekrar teşekkür ederim.
 
Çizgiler arasında yazdığım
FrekansAralıgi = 50
FrekansSayisi = 5
Değerlerini değiştirerek istediğiniz frekans atlamasını yapabilirsiniz.

Bir şey daha var "Değerlendirme" sayfasına yazılan "Tarih" verisi atlama yapılan ilk Frekansa ait tarihtir.

Kod:
Sub Istatistik()
    Dim Bak As Integer
    Dim Bak2 As Integer
    Dim SatirSayData As Integer
    Dim SatirSayDeg As Integer
    Dim FrekansAralıgi As Integer
    Dim FrekansSayisi As Integer
    
    '-----------------------------
    FrekansAralıgi = 50
    FrekansSayisi = 5
    '-----------------------------
    
    SatirSayData = Worksheets("Data").Cells(Rows.Count, "A").End(3).Row
    For Bak = 2 To SatirSayData Step FrekansAralıgi + FrekansSayisi
        With Worksheets("Değerlendirme")
            SatirSayDeg = .Cells(Rows.Count, "A").End(3).Row + 1
            .Cells(SatirSayDeg, 1) = SatirSayDeg - 1
            .Cells(SatirSayDeg, 2) = Worksheets("Data").Cells(Bak, 2)
            For Bak2 = 1 To FrekansSayisi
                .Cells(SatirSayDeg, Bak2 + 2) = Worksheets("Data").Cells(Bak, 3)
            Next
        End With
    Next
End Sub
 
Sayın dalgalıkur'un verdiği kodlardaki

Kod:
FrekansAralıgi = 50
FrekansSayisi = 5

kısmını aşağıdaki gibi değiştirerek Data sayfasına bağlayabilirsiniz:

Kod:
FrekansAralıgi = Sheets("Data").[D2]
FrekansSayisi = Sheets("Data").[F2]
 
Sonu gelmiyor derken neyi kast ettiğinizi anlayamadım.
Eklediğiniz fotoda neresinde hata-sorun olduğunu belirtseydiniz daha iyi olurdu.
 
Merhaba

Ben örnek verileri ayın 2'sinden 7'sine kadar girmiştim. Değerlendirme sayfasındaki veri tarihlerine bakarsanız, data sayfasındaki verilerin işlenmesi bittikten sonra makronun başa dönüp aynı verileri almaya devam ettiğini görürsünüz.

Benim yapmak istediğim, sayfadaki verileri bitirene kadar makroyu bir döngüye sokup istenen verileri değerlendirme sayfasına almak. Sayfadaki veriler bitince "işlem tamamlandı" gibi bir mesaj verip makro durmalı.

Bu yapmak istediğim işlem yaklaşık 17.000 satırlık bir veri işleyecek. Döngü kullanmazsam bu veriyi işleyemem.

Umarım anlatabilmişimdir. Yardımlarınız için tekrar tekrar teşekkür ediyorum, başınızı ağrıttığım için kusura bakmayın.
 
Verilerin işlenmesi bittikten sonra makro başa dönmüyor işlem bitiyor.

Aynı verilerin tekrar işlenmesinin sebebi makronun üst üste birden fazla çalıştırılmış olmasından kaynaklanıyor.

Değerlendirme sayfasındaki verileri silip kodları bir kez çalıştırırsanız verilerin bir kere işlendiğini iki kere çalıştırırsanız iki kere işlendiğini göreceksiniz.

Ben şimdi bir ekleme yaptım eğer değerlendirme sayfasında veri varsa kodlar yeniden çalıştırılsın mı diye soracak.
İşlem bittiğinde mesajda verecek.

Kod:
Sub Istatistik()
Sub Istatistik()
    Dim Bak As Integer
    Dim Bak2 As Integer
    Dim SatirSayData As Integer
    Dim SatirSayDeg As Integer
    Dim FrekansAralıgi As Integer
    Dim FrekansSayisi As Integer
    
    '-----------------------------
    FrekansAralıgi = 50
    FrekansSayisi = 5
    '-----------------------------
    
    If 1 < Worksheets("Değerlendirme").Cells(Rows.Count, "A").End(3).Row Then
        If MsgBox("Değerlendirme sayfasında işlenmiş veriler zaten var, verileri işlemeye devam etmek istiyor musunuz?", vbQuestion + vbYesNo) = vbNo Then
            Exit Sub
        End If
    End If
    
    
    SatirSayData = Worksheets("Data").Cells(Rows.Count, "A").End(3).Row
    For Bak = 2 To SatirSayData Step FrekansAralıgi + FrekansSayisi
        With Worksheets("Değerlendirme")
            SatirSayDeg = .Cells(Rows.Count, "A").End(3).Row + 1
            .Cells(SatirSayDeg, 1) = SatirSayDeg - 1
            .Cells(SatirSayDeg, 2) = Worksheets("Data").Cells(Bak, 2)
            For Bak2 = 1 To FrekansSayisi
                .Cells(SatirSayDeg, Bak2 + 2) = Worksheets("Data").Cells(Bak, 3)
            Next
        End With
    Next
    MsgBox "İşlem bitmiştir."
End Sub
End Sub
 
Haklısınız ben hiç öyle düşünmemiştim. Çok teşekkür ederim yardımlarınız için, beni ne büyük bir yükten kurtardığınızı tahmin edemezsiniz.

Emeğinize sağlık, sağlıcakla kalın.
 
Son 30 veriyi kopyalama

Merhabalar,
Benim de benzer bir problemim var, siteyi taradım ama benim istediğime benzer bir çalışma bulamadım. Benim de iki sayfam var data ve analiz diye, data sayfasına tarih ve o tarihe karşılık gelen değerler var. Ben analiz sayfasına data sayfasından hep son 30 güncel değeri almak istiyorum. İşin içinden çıkamadım. Yardımcı olabilirseniz çok sevinirim.
İyi günler
 

Ekli dosyalar

Geri
Üst