Döngü Makrosunda Hata

[Kenantu]

Merhabalar Dostlarım

Bir Userform üzerinde 12 adet TextBox ım var bunların adı hesapadi1,...,12 diye adlandırdım. Bu Textboxlara yazdırdığım hesap adları ile aynı olan sheet lerim var ve bu sheet leri açtırarak veriler giriyorum bu iş içinde bir döngü yazdım ama bir türlü çalıştıramıyorum bana aşağıda yazdığım kotların neresinde hata yaptığımı söylerseniz çok sevinirim. Teşekkürler.

Private Sub cmdkaydet_Click()
Dim k As Integer
For k = 1 To 12
Sheets(["hesapadi" & k].Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = ["borcusd" & k].Value
ActiveCell.Offset(0, 3).Value = ["alacakusd" & k].Value
ActiveCell.Offset(0, 7).Value = Val(["borc" & k].Value) - Val(["alacak" & k].Value)



Next k
Sheets("MİZAN").Select
MsgBox "KAYIT İŞLEMİNİZ TAMAMLANMIŞTIR"


End Sub

 

[Levent Menteşoğlu]

Sheets(["hesapadi" & k].Value).Select

Yukarıdaki yazım şekli hatalıdır, aşağıdaki gibi deneyin.

Sheets("hesapadi" & k).Select

 

[Kenantu]

Sayın Levent hocam

İstemiş olduğunuz gibi değişikliği yaptın yine hata verdi aynı satırda

Run time error 9
Subscript out of range

hatası

 

[emrexcel123]

sayfa adı

arkadaşım bu hata genelde sayfa adında hata varsa verir bence bu sayfa isimlerini bir değişkene ata...

 

[ildogan]

Örnek dosya eklerseniz üzerinde çalışabiliriz.

 

[Kenantu]

Sayın Emre

Sayfa adlarında sorun yok neden derseniz her TextBox için ayrı makro yazdığımda sayfaları buluyor hemde hiç sorun yapmadan ve yapması gereken işlemleri yapıyor ben yazılımı azaltmak ve her TextBox için ayrı bir yazılım yapmayayım diye böyle bir döngü kurmak istedim ama çalışmadı. Ayrıca dosyam yaklaşık 6,9 Mb bu yüzden gönderemiyorum arzu edenler için rapidshare atayım diyeceğim ama içinde o kadar çok makro varki sizleri bunaltmak istemem ama isterseniz gönderebilirim
Hepinize ilginiz ve alakanız için tekrardan teşekkürü bir borç bilirim

 

[Kenantu]

Private Sub cmdkaydet_Click()

If toplamborc.Value = toplamalacak.Value Then

If hesapadi1.Value = "" Then GoTo 200
Sheets(hesapadi1.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd1.Value
ActiveCell.Offset(0, 3).Value = alacakusd1.Value
ActiveCell.Offset(0, 7).Value = Val(borc1.Value) - Val(alacak1.Value)
200:

If hesapadi2.Value = "" Then GoTo 210
Sheets(hesapadi2.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd2.Value
ActiveCell.Offset(0, 3).Value = alacakusd2.Value
ActiveCell.Offset(0, 7).Value = Val(borc2.Value) - Val(alacak2.Value)
210:

If hesapadi3.Value = "" Then GoTo 215
Sheets(hesapadi3.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd3.Value
ActiveCell.Offset(0, 3).Value = alacakusd3.Value
ActiveCell.Offset(0, 7).Value = Val(borc3.Value) - Val(alacak3.Value)
215:

If hesapadi4.Value = "" Then GoTo 220
Sheets(hesapadi4.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd4.Value
ActiveCell.Offset(0, 3).Value = alacakusd4.Value
ActiveCell.Offset(0, 7).Value = Val(borc4.Value) - Val(alacak4.Value)
220:

If hesapadi5.Value = "" Then GoTo 225
Sheets(hesapadi5.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd5.Value
ActiveCell.Offset(0, 3).Value = alacakusd5.Value
ActiveCell.Offset(0, 7).Value = Val(borc5.Value) - Val(alacak5.Value)
225:

If hesapadi6.Value = "" Then GoTo 230
Sheets(hesapadi6.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd6.Value
ActiveCell.Offset(0, 3).Value = alacakusd6.Value
ActiveCell.Offset(0, 7).Value = Val(borc6.Value) - Val(alacak6.Value)
230:

If hesapadi7.Value = "" Then GoTo 235
Sheets(hesapadi7.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd7.Value
ActiveCell.Offset(0, 3).Value = alacakusd7.Value
ActiveCell.Offset(0, 7).Value = Val(borc7.Value) - Val(alacak7.Value)
235:

If hesapadi8.Value = "" Then GoTo 240
Sheets(hesapadi8.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd8.Value
ActiveCell.Offset(0, 3).Value = alacakusd8.Value
ActiveCell.Offset(0, 7).Value = Val(borc8.Value) - Val(alacak8.Value)
240:

If hesapadi9.Value = "" Then GoTo 245
Sheets(hesapadi9.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd9.Value
ActiveCell.Offset(0, 3).Value = alacakusd9.Value
ActiveCell.Offset(0, 7).Value = Val(borc9.Value) - Val(alacak9.Value)
245:

If hesapadi10.Value = "" Then GoTo 250
Sheets(hesapadi10.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd10.Value
ActiveCell.Offset(0, 3).Value = alacakusd10.Value
ActiveCell.Offset(0, 7).Value = Val(borc10.Value) - Val(alacak10.Value)
250:

If hesapadi11.Value = "" Then GoTo 255
Sheets(hesapadi11.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd11.Value
ActiveCell.Offset(0, 3).Value = alacakusd11.Value
ActiveCell.Offset(0, 7).Value = Val(borc11.Value) - Val(alacak11.Value)
255:

If hesapadi12.Value = "" Then GoTo 260
Sheets(hesapadi12.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd12.Value
ActiveCell.Offset(0, 3).Value = alacakusd12.Value
ActiveCell.Offset(0, 7).Value = Val(borc12.Value) - Val(alacak12.Value)
260:
Sheets("MİZAN").Select
MsgBox "KAYIT İŞLEMİNİZ TAMAMLANMIŞTIR"

Else: MsgBox "FİŞ BAKİYELERİ TUTMUYOR LÜTFEN KONTROL EDİNİZ...."


End If


Sayın Emre Hocam işte yukarıdaki gibi bir yazılım yapınca sayfaları buluyor ve ilgili işlemleri yapıyor. Size çalışan kotları göndereyimki belki başka bir kısaltma yolu bulursunuz bana iyişallah gözlerinizi ve beyninizi fazla yormam kusuruma bakmayın tekrardan teşekkür ederim

 

[zafer]

Merhaba

hesapadi1 sayfa ismiyse
Sheets("hesapadi1").Select olarak kullanılır.

Hesapadi1 eğer değişken ismiyse o zaman sizinki gibi kullanılır.

Levent bey yukarıda size izah etmiş.Bakmadınızmı

 

[Kenantu]

Sayın Zafer hocam

Benim en üstte yadığım makro satırlarına bakarsanız orda değişken olanın hesapadi1 de rakkam kısmının değişken olduğunu görürsünüz zaten bende sizin bana yazdığınız şekilde her textbox için ayrı bir yazılım yaparak olayı çözdüm amacım sadece bir üstte gördüğünüz yazılımı kısaltıpkısaltamayacağım daha doğrusu hocam elimde 12 tane textbox var bunların adları "hesapadi1 diye başlayıp hesapadi12" diye bitiyor ve aldıkları değerlerle sheets seçtirip o sheet lere bilgi giriyorum bu kotta çok uzun oluyor normal yazarsak ben bir döngü ile bunu kısaltmak istedim ama beceremedim o yüzden sizlere sordum böyle bir kısaltma mümkünmü diye ilginiz için tekrardan teşekkür ederim sağolun

 

[zafer]

Merhaba

Sayın Levent hocam

İstemiş olduğunuz gibi değişikliği yaptın yine hata verdi aynı satırda

Run time error 9
Subscript out of range

hatası

Aynı satır dediğiniz hangi satır.
Ayrıca hesapadı1 ,2,3..... değişken diyorsunuzda bu değişkeninin döngüsü nerede

Bu kadar uzun kodların olmasının sebebi nedir.
Yukarıda Sayın levent beyin kodları ile sayfayı seçin zaten hücre adresleriniz değişmiyor onları bağlayın.

Olmazsa dosyanızı ekleyiniz.

 

[Kenantu]

Zafer hocam

En yukarıdaki ilk yazıma bakarsanız orada döngüyü göreceksiniz ama o yazdığım döngü çalışmadı. Çalışmayan satır ise aşağıdaki satırdır. Bu satırı bana levent hocam önerdi oda çalışmadı hata verdi
Sheets("hesapadi" & k).Select

Gelelim uzun yazılıma bu uzun yazılım çalışıyor sorunsuz. En yukarıdaki yani ilk yazımda bu uzun makroyu kısaltmak için yazdığım ilk makroyu göreceksiniz işte çalışmayan makro o hocam. Gelelim dosyaya dosyanın boyutu 6,7 Mb bu yüzden gönderemiyorum ama şimdi bir yere yüklemeye çalışacağım size oradan göndereceğim
teşekkürler hocam

 

[Kenantu]

http://rapidshare.com/files/25605399/KEMER07.xls.html

dosya bu adrese yüklenmiştir isteyen dostlarım inceleyebilirler. Herkeze tekrar tekrar teşekkür ederim

 

[Levent Menteşoğlu]

..... Bu satırı bana levent hocam önerdi oda çalışmadı hata verdi
Sheets("hesapadi" & k).Select

Çalışmaması normal çünkü bu satırda hesap adları ile textbox adlarının aynı olduğunu düşünmüştüm. Aşağıdaki gibi düzeltin.

For k = 1 To 12
Sheets(controls("hesapadi" & k).Value).Select
.
.

Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd1.Value
ActiveCell.Offset(0, 3).Value = alacakusd1.Value
ActiveCell.Offset(0, 7).Value = Val(borc1.Value) - Val(alacak1.Value)

Birde merak ettiğim için soruyorum neden yukarıdaki gibi dolaylı adres içeren bir kodlama mantığı ile ilk boş satırı bulmak için döngü kullanıyorsunuz.

 

[Kenantu]

Levent hocam

Ben aslında çok ileri seviyede excel bilgisi olan biri değilim . Öğrendiğim ve bildiğim yöntemler dışına çıkıp fazla araştırma yapamıyorum oldukça yoğun biriyim ve iş yerinden bağlanıyorum ve bilmemek değil öğrenmemek ayıptır cümlesine sonuna kadar inanıyorum. Bu doğrultuda öğrenmediğim için ayıp eden benim hocam ne olur kusuruma bakmayın eğer değişik bir yöntemi varsa öğrenmeyi çok isterim
Teşekkürler

 

[Levent Menteşoğlu]

Sheets(hesapadi1.Value).Select
Range("A1").Select
ActiveCell.Offset(1, 0).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, 0).Value = tarih.Value
ActiveCell.Offset(0, 1).Value = aciklama.Value
ActiveCell.Offset(0, 2).Value = borcusd1.Value
ActiveCell.Offset(0, 3).Value = alacakusd1.Value
ActiveCell.Offset(0, 7).Value = Val(borc1.Value) - Val(alacak1.Value)

Yukarıdaki kısmı aşağıdaki gibi düzenleyebilirsiniz. Direk hücre adresleri kullanıldığı için anlaşılması daha kolay olacaktır.

set s1=Sheets(hesapadi1.Value)
sat=s1.[a65536].end(3).row+1 [COLOR=green]'son boş satırı bulur[/COLOR]
s1.cells(sat,"a")= tarih.Value
s1.cells(sat,"b")= aciklama.Value
s1.cells(sat,"c")= borcusd1.Value
s1.cells(sat,"d")= alacakusd1.Value
s1.cells(sat,"h")= Val(borc1.Value) - Val(alacak1.Value)
.
.
.

 

[Kenantu]

Levent hocam

Ah keşke yakınızda olsamda engin bilgilerinizden biraz yararlansam ne güzel olurdu hocam sırası gelmişken son satırı bulup o satırı içindeki formüllerle bir alt satıra kopyalayan bir makro nasıl yazılır biraz bilgi verirseniz çok sevinirim bu dosyamın boyutunu küçültmek için istiyorum dosyamın boyutu formüllü satırlar yüzünden çok büyüdüde
Çok çok teşekkür ederim hocam allah razı olsun açmış olduğunuz yeni yolda yürümeye başlayacağım