• DİKKAT

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

Bir excel dosyasındaki verileri ekranda aşağı doğru kaydırmak nasıl olur?

  • Konbuyu başlatan Konbuyu başlatan etooom
  • Başlangıç tarihi Başlangıç tarihi
E

etooom

Katılım
25 Mayıs 2007
Mesajlar
7
Excel Vers. ve Dili
excel 2007
Merhaba.
Benim istediğim bir şeyi çok bilgim olmadığı için yapamadım. Bir çok şey denedim ama olmadı. Eğer yardımcı olursanız sevinirim.


Bende bir excel sayfası var. Bu sayfadaki satır sayısı devamlı değişiyor. Ben bu sayfayı tv de aşağı doğru kaydırarak izlemek istiyorum.
ama veri olan son satıra geldiğinde başa dönüp tekrar kaydırmaya devam etmesini istiyorum.
Saçma ama şöyle bir şeyler denedim ama başaramadım. Satırları alt alta kopyalayarak işimi ir nebze gördü ama birinin kontrol etmesi gerek.
Daha basiti kesin vardır.

Teşekkürler.

Sub kaydırma()
'
' kaydırma Makro
'

'
If Range("A1").Value = "" Then
ActiveWindow.SmallScroll Up:=5000
run ("kaydırma")

Else:
ActiveWindow.SmallScroll Down:=3
Application.Wait Now + TimeValue("00:00:03")
End If
If Range("A4").Value = "" Then
ActiveWindow.SmallScroll Up:=5000
run ("kaydırma")

Else:
ActiveWindow.SmallScroll Down:=3
Application.Wait Now + TimeValue("00:00:03")
End If

If Range("A7").Value = "" Then
ActiveWindow.SmallScroll Up:=5000
run ("kaydırma")

Else:
ActiveWindow.SmallScroll Down:=3
Application.Wait Now + TimeValue("00:00:03")
End If

End Sub
 
Anladığım kadarı ile yapmaya çalıştım
Kodu sayfanın kod bölümüne koyun mause ile herhangibir hücreyi tıklayın veya enter tuşuna basın kod çalışacaktır her üç saniyede bir üç satır atlıyor.

Kod: 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.Wait Now + TimeValue("00:00:03")
say = 3
If Target.Row + say + 1 > Rows.Count Then
Cells(1, 1).Select
Else
Cells(Target.Row + say, 1).Select
End If
End Sub
 
Sarı satırda takılyor. Yanlış bir şey mi yaptım acaba.
Teşekkür ederim.

Sub Kaydir()
Application.Wait Now + TimeValue("00:00:03")
say = 3
If Target.Row + say + 1 > Rows.Count Then
Cells(1, 1).Select
Else
Cells(Target.Row + say, 1).Select
End If
End Sub
 
etooom' Alıntı:
Sarı satırda takılyor. Yanlış bir şey mi yaptım acaba.
Teşekkür ederim.

Sub Kaydir()
Application.Wait Now + TimeValue("00:00:03")
say = 3
If Target.Row + say + 1 > Rows.Count Then
Cells(1, 1).Select
Else
Cells(Target.Row + say, 1).Select
End If
End Sub
Genişletmek için tıkla ...


Bu benim yazdığım kod değil benim size yazdığım kodu sayfanın kod bölümüne kayup çalıştıracaksınız eğer bir modülün içine koyup çalıştırırsanız bu kodu kullanın buda kendi başına çalışmaz bir dögüye girmei gerek veya sayfanın Worksheet_SelectionChange bölümünde çalıştırmanız gerek


kod

Kod: 
Sub Kaydir()
Application.Wait Now + TimeValue("00:00:03")
say = 3
If ActiveWindow.Selection.Row + say + 1 > Rows.Count Then
Cells(1, 1).Select
Else
Cells(ActiveWindow.Selection.Row + say, 1).Select
End If
End Sub
 
Ekli dosyayı kontrol edin

kod:

Kod: 
Option Explicit
Dim NextTick
Dim say
Sub çalıştır()
kaydır
End Sub
Sub durdur()
On Error Resume Next
Application.OnTime NextTick, "kaydır", , False
End Sub
Sub kaydır()
say = say + 3
If say + 1 > Rows.Count Then
ActiveWindow.SmallScroll Down:=1
Else
ActiveWindow.SmallScroll Down:=3
End If
NextTick = Now + TimeValue("00:00:03")
Application.OnTime NextTick, "kaydır"
End Sub
 

Ekli dosyalar

Hocam merhaba.
Yolladığınız excel dosyasını denedim. Sanırım acemi olduğum çok belli oldu. Yerime siz dosya oluşturmuşsunuz :) Teşekkürler.
Dosyada aşağı doğru kaydırma tamam.
Ama benim istediğim şey şu: veri olan satırlar bitince tekrar ilk satıra dönsün ve aşağı doğru kaydırmaya başlasın.
Yoksa birinin TV yi izleyip devamlı başa döndürme işini gidip o PC de elle yapması lazım.
 
etooom' Alıntı:
Hocam merhaba.
Yolladığınız excel dosyasını denedim. Sanırım acemi olduğum çok belli oldu. Yerime siz dosya oluşturmuşsunuz :) Teşekkürler.
Dosyada aşağı doğru kaydırma tamam.
Ama benim istediğim şey şu: veri olan satırlar bitince tekrar ilk satıra dönsün ve aşağı doğru kaydırmaya başlasın.
Yoksa birinin TV yi izleyip devamlı başa döndürme işini gidip o PC de elle yapması lazım.
Genişletmek için tıkla ...

Siz kendi örnek dosyanızı ekleyinde ne yapmak istediğinize bakalım
 
merhaba Hocam.
Ekli dosyada benim daha önce yaptığım makroyu çalıştırınca 3 er saniye bekliyor. Her seferinde A5X hücresi dolu mu diye bakıyor. Doluysa aşağı 3 sıra kaydırıyor sayfayı. Boş ise makroyu baştan çalıştırıyor. Tabii çözüm bu olacaksa ben makro içindeki satırları çoğaltacağım. Sadece örnek olsun diye yazdım. İlkel bir çözüm :)
Benim istediğimi sanırım anlamışsındır.
İsteğim şu: Bu exce ldosyasındaki ekran aşağı doğru aksın. Veri bitince en baş satıra dönsün yeniden aksın.
Ama veri satır sayısı değişiyor. Mesela bu örnekte 524 satır. Ama yarın 500 satır olabiliyor veya siparişler artınca 800 satır oluyor.
İlgine şimdiden teşekkürler.
 

Ekli dosyalar

Kod A sütunun daki son dolu hücreye göre çalışıyor.
 

Ekli dosyalar

Hocam eline sağlık. Tam istediğim gibi olmuş.
İlgine ve emeğine çok teşekkürler.
 
yanıt

Hocam tekrar merhaba.
Kusura bakma. En nefret ettiğim şey gerçekleşti. Bir işi yapmadan önce düşünmek lazım. Ama bizim planlamacı arkadaş pek plancı değilmiş anlaşılan.

Her şey bittikten ve defalarca konuştuktan sonra bana şöyle dedi:
"Bu tamam ama sayfa bitince "Kesim Progam"r sheet ine geçsin onu kaydırsın. o da bitince "Dikim Program" sheet ine gitsin, onu kaydırsın. Sonra yine en baştaki "list" sheetine gitsin onu kaydırmaya baştan başlasın"
Şimdi sizden bunu isterken çekiniyorum. Zaten yapmazsanız da anlarım.

Bu dediğim yapılabilecek bir şey mi?
Tekrar kusura bakma.
Ekli dosyada görebilirsin.
 

Ekli dosyalar

kod:

Kod: 
Option Explicit
Dim NextTick
Dim say
Dim say2
Dim say3
Sub çalıştır()
On Error Resume Next
say = ActiveWindow.Selection.Row
say2 = 1
say3 = ActiveWorkbook.Sheets.Count
Sheets(1).Select
kaydır2
End Sub
Sub durdur()
On Error Resume Next
Cells(say, 1).Select
say2 = 1
say3 = ActiveWorkbook.Sheets.Count
Application.OnTime NextTick, "kaydır2", , False
End Sub
Sub kaydır2()
Dim son
Dim son1
son1 = 3
say = say + son1
son = Cells(Rows.Count, "a").End(3).Row + 1
If say + 1 > son Then
Cells(3, 1).Select
say = 2
say2 = say2 + 1
If say2 > say3 Then say2 = 1
Sheets(say2).Select
Else
ActiveWindow.SmallScroll Down:=3
End If
NextTick = Now + TimeValue("00:00:03")
Application.OnTime NextTick, "kaydır2"
End Sub
 
Çok çok teşekkürler.
Valla sabrınıza mı hızınıza mı şaşıracağımı şaşırdım :)
Süper çalışıyor.
 
etooom' Alıntı:
Çok çok teşekkürler.
Valla sabrınıza mı hızınıza mı şaşıracağımı şaşırdım :)
Süper çalışıyor.
Genişletmek için tıkla ...

İyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst