• DİKKAT

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

Kodun içindeki sayıyı artırmak

S

SpyHepyek

Katılım
5 Aralık 2011
Mesajlar
9
Excel Vers. ve Dili
2007 Türkçe
Arkadaş merhaba,

kodun içindeki sayıyı sırasına göre (satır sırası) nasıl artırabilirim?

Koddan
Alıntı:
bilgisayar'10000'bilgisayar
teknoloji bilgisayar
bilgisayar'10001'bilgisayar
teknoloji bilgisayar
bilgisayar'10002'bilgisayar
teknoloji bilgisayar
bilgisayar'10003'bilgisayar
teknoloji bilgisayar

Teşekkürler şimdiden.
 
Merhaba,
Örnek dosya ekleyiniz.
 
Merhaba,

Açmış olduğunuz diğer başlıktan anladığım kadarıyla aşağıdaki gibi bir döngü işinize yarayabilir. Delphide çalışırmı emin değilim.

Kod: 
For X = 10000 To 99999
    SendKeys(PChar('" & [COLOR=red]X[/COLOR] & "'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{ENTER}'),true);
    SendKeys(PChar('{ENTER}'),true);
    SendKeys(PChar('{ENTER}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{delete}'),true);
    SendKeys(PChar('{ENTER}'),true);
Next
 
Merhaba,
Aşağıdaki kodu deneyin.
Kod: 
Sub artir()
For x = 1 To Cells(Rows.Count, 1).End(3).Row Step 13
deg = Split(Cells(x, 1), "'")
Cells(x, 1) = WorksheetFunction.Substitute(Cells(x, 1), deg(1), deg(1) + 1)
Next
MsgBox "İşlem tamamlanmıştır.", vbInformation, "leumruk"
End Sub
 
Korhan Ayhan' Alıntı:
Merhaba,

Açmış olduğunuz diğer başlıktan anladığım kadarıyla aşağıdaki gibi bir döngü işinize yarayabilir. Delphide çalışırmı emin değilim.

Kod: 
For X = 10000 To 99999
    SendKeys(PChar('" & [COLOR=red]X[/COLOR] & "'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{ENTER}'),true);
    SendKeys(PChar('{ENTER}'),true);
    SendKeys(PChar('{ENTER}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{tab}'),true);
    SendKeys(PChar('{delete}'),true);
    SendKeys(PChar('{ENTER}'),true);
Next
Genişletmek için tıkla ...

Hocam teşekkür ederim ama bu kodu Delphi'ye göre çevirip kullanmam mümkün değil çok fazla kasacağı için.




leumruk' Alıntı:
Merhaba,
Aşağıdaki kodu deneyin.
Kod: 
Sub artir()
For x = 1 To Cells(Rows.Count, 1).End(3).Row Step 13
deg = Split(Cells(x, 1), "'")
Cells(x, 1) = WorksheetFunction.Substitute(Cells(x, 1), deg(1), deg(1) + 1)
Next
MsgBox "İşlem tamamlanmıştır.", vbInformation, "leumruk"
End Sub
Genişletmek için tıkla ...

Hocam size de teşekkür ederim. İşlem tamam ama bu olayı 99999 sayısına kadar nasıl yapabiliriz?
 
Pekala sorun çözdüldü... Çoklu olarak artırmak için de verdiğiniz kodu alt alta yazıp makroyu çalıştırıyoruz... Teşekkür ederim emektarlara...

Saygılar.

Edit: Yanlış anlaşılma oldu, olay kısmen çözüldü. Tam anlamıyla çözümlenmiş değildir.
 
Son düzenleme:
SpyHepyek' Alıntı:
Hocam size de teşekkür ederim. İşlem tamam ama bu olayı 99999 sayısına kadar nasıl yapabiliriz?
Genişletmek için tıkla ...
Bu kod excele ne kadar ekleme yaparsanız o kadar döngü oluşturur. Sayı sınırlaması yoktur. Çalışma mantığı şu:
1. satırdan başlamak üzere her 13 satırdan sonraki metinde bulunan sayıya 1 ekleyerek devam eder.
Dikkat etmeniz gereken: Tüm verilerinizin aynı düzende ve sırada olması gereğidir.
 
leumruk' Alıntı:
Bu kod excele ne kadar ekleme yaparsanız o kadar döngü oluşturur. Sayı sınırlaması yoktur. Çalışma mantığı şu:
1. satırdan başlamak üzere her 13 satırdan sonraki metinde bulunan sayıya 1 ekleyerek devam eder.
Dikkat etmeniz gereken: Tüm verilerinizin aynı düzende ve sırada olması gereğidir.
Genişletmek için tıkla ...



Hocam alta doğru akıp gitmesini istiyorum ben bu olayın. Değerler öylece kalıyor hücrelerde yani şu şekilde olmasını istiyorum ama olmadı;


Kod: 
SendKeys(PChar('10000'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{delete}'),true);
SendKeys(PChar('{ENTER}'),true);


SendKeys(PChar('10001'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{delete}'),true);
SendKeys(PChar('{ENTER}'),true);


SendKeys(PChar('10002'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{delete}'),true);
SendKeys(PChar('{ENTER}'),true);


SendKeys(PChar('10003'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{delete}'),true);
SendKeys(PChar('{ENTER}'),true);


SendKeys(PChar('10004'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{delete}'),true);
SendKeys(PChar('{ENTER}'),true);

böyle 99999'a kadar ilerlemiyor.
 
Soruyu ben sizin adınıza kendime yöneltiyorum. Doğruysa evet doğru demeniz yeterli.
Soru: Elinizde bu şekilde blok halinde bir veri var. Siz bu bloğun ilk satırında bulunan sayının bir artarak alt alta kopyalanmasını mı istiyorsunuz?
Kod: 
SendKeys(PChar('10000'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{delete}'),true);
SendKeys(PChar('{ENTER}'),true);
 
leumruk' Alıntı:
Soruyu ben sizin adınıza kendime yöneltiyorum. Doğruysa evet doğru demeniz yeterli.
Soru: Elinizde bu şekilde blok halinde bir veri var. Siz bu bloğun ilk satırında bulunan sayının bir artarak alt alta kopyalanmasını mı istiyorsunuz?
Kod: 
SendKeys(PChar('10000'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{ENTER}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{tab}'),true);
SendKeys(PChar('{delete}'),true);
SendKeys(PChar('{ENTER}'),true);
Genişletmek için tıkla ...

Evet doğru.
 
Aşağıdaki gibi deneyin.

Kod: 
Sub listele()
For a = 10000 To 99999
Cells(c + 1, "a") = "SendKeys(PChar('" & a & "'),true);"
Cells(c + 2, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 3, "a") = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 4, "a") = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 5, "a") = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 6, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 7, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 8, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 9, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 10, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 11, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 12, "a") = "SendKeys(PChar('{delete}'),true);"
Cells(c + 13, "a") = "SendKeys(PChar('{ENTER}'),true);"
c = c + 14
Next
End Sub
 
Levent Menteşoğlu' Alıntı:
Aşağıdaki gibi deneyin.

Kod: 
Sub listele()
For a = 10000 To 99999
Cells(c + 1, "a") = "SendKeys(PChar('" & a & "'),true);"
Cells(c + 2, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 3, "a") = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 4, "a") = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 5, "a") = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 6, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 7, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 8, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 9, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 10, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 11, "a") = "SendKeys(PChar('{tab}'),true);"
Cells(c + 12, "a") = "SendKeys(PChar('{delete}'),true);"
Cells(c + 13, "a") = "SendKeys(PChar('{ENTER}'),true);"
c = c + 14
Next
End Sub
Genişletmek için tıkla ...



1048576'ncı satırdan sonra bitti hocam ekleme yapmadı :)
 
Levent Bey'in kodu üzerinde yapılacak bir düzenlemeyle bu sorun aşılabilir. Yan sütundan devam edecektir.
Kod: 
Sub listele()
Sut = 1
For a = 10000 To 99999
Cells(c + 1, Sut) = "SendKeys(PChar('" & a & "'),true);"
Cells(c + 2, Sut) = "SendKeys(PChar('{tab}'),true);"
Cells(c + 3, Sut) = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 4, Sut) = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 5, Sut) = "SendKeys(PChar('{ENTER}'),true);"
Cells(c + 6, Sut) = "SendKeys(PChar('{tab}'),true);"
Cells(c + 7, Sut) = "SendKeys(PChar('{tab}'),true);"
Cells(c + 8, Sut) = "SendKeys(PChar('{tab}'),true);"
Cells(c + 9, Sut) = "SendKeys(PChar('{tab}'),true);"
Cells(c + 10, Sut) = "SendKeys(PChar('{tab}'),true);"
Cells(c + 11, Sut) = "SendKeys(PChar('{tab}'),true);"
Cells(c + 12, Sut) = "SendKeys(PChar('{delete}'),true);"
Cells(c + 13, Sut) = "SendKeys(PChar('{ENTER}'),true);"
c = c + 14
If c >= 1048568 Then c = 0: Sut = Sut + 2
Next
End Sub
 
@Levent Menteşoğlu, @leumruk

Sayın hocalarım, çok teşekkür ederim. Olay tamamı ile çözülmüştür.

Saygılarımla,
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst