Sayfa1'deki düşeyara'da #YOK çıkan satırları tablo2'ye

kasif2 · 28 Ocak 2006

Selam;

Bu tabloda tablo1'de iki ayrı tablo var"İzmir - Ankara diye". Bu tablolarda eğer soldaki tablodaki para sağda da varsa yanında değer var, yoksa #YOK yazıyor.

Ben bu #YOK yazanları "EÃLEÃMEYENLERİ AKTAR" butonuna basınca tablo2'ye aktarmak istiyorum. (Ekteki tabloda elle attım.) Bu makro ile yapılabilir mi??

Ãimdiden teşekkürler...

TRABLUS · 28 Ocak 2006

Bu elle yaptığınız işlemi yaparken aşağıda tarif ettiğim işlemi yapsaydınız bu işlemi makro ile kendiniz yapmış olabilirdiniz.
Araçlar > Makro > yeni makro kaydet
dedikten sonra elle manuel yaptığınız işlemi yapınız. Sonra kaydı durdur düğmesine basınız. ( Kayıt işlemine başlamadan önce Makronun saklanacağı yer kısmını açıp oraya Kişisel makro çalışma kitabı'nı işaretlerseniz diğer tüm çalışma kitaplarında bu işlemi yapabilirsiniz.)
Bundan sonra Araçlar > Makro > Makrolar dedikten sonra kaydettiğiniz makro'yu işaretleyip çalıştır dediğiniz de istediğiniz olacaktır.

kasif2 · 28 Ocak 2006

Fakat bu her ay değişen bir tablo, bu tabloda 500 kalem para oluyor, bunu makro ile aktar yaparak aktarmanın daha pratik olacağını düşünüyorum.

TRABLUS · 28 Ocak 2006

bunu makro ile aktar yaparak aktarmanın daha pratik olacağını düşünüyorum.

Benim size önerdiğim çözümde makro ile idi.
Makro kaydet dedikten sonra hücrelerde veri > süz yapacaksınız ve orada #YOK yazanları seçip kopyalayıp diğer tarafa kaydettiğiniz vakit, makro bunu kendisi kaydederken #YOK olanları süzde bulur. Dolayısıyla başka bir zaman kullanacağınızda, Pc'niz sadece #YOK olanları bulur ve diğer tarafa yapıştırır. İsterseniz bunu bir deneyin, haklı olduğumu göreceksiniz.

kasif2 · 28 Ocak 2006

Bu da pek işe yaramadı, dediğiniz gibi yaptım fakat makroyu çalıştırdığımda sağda sadece#YOK'ları alırken soldaki değerlerin tamamını aktardı.

Levent Menteşoğlu · 28 Ocak 2006

Aşağıdaki kodu deneyin.

[vb:1:9418aed0c6]Sub aktar()
Set s1 = Sheets("ARALIK-AKTAR")
adr = "f6:f" & [d65536].End(3).Row
adres = Range(adr).SpecialCells(xlCellTypeFormulas, 16).Address
For Each hucre In Range(adres)
If hucre.Offset(0, -2) = 0 Then GoTo 10
son = s1.[e65536].End(3).Row + 1
s1.Cells(son, "b") = hucre.Offset(0, -4)
s1.Cells(son, "c") = hucre.Offset(0, -3)
s1.Cells(son, "d") = hucre.Offset(0, -2)
s1.Cells(son, "e") = hucre.Offset(0, -1)
10 Next
MsgBox "VERİLER AKTARILDI"
End Sub
[/vb:1:9418aed0c6]

kasif2 · 29 Ocak 2006

Sn. Leventm;

Kod için teşekkürler, sorunsuz çalışıyor.

Ayrıca sizin tablodan uyarlayarak Ankara tablosunu aktarmak için kodu uyarladım. Ãimdi ikisini birden aktarıyor.

Kod:

Sub YOKAKTAR()
Set s1 = Sheets("ARALIK-AKTAR")
adr = "f6:f" & [e65536].End(3).Row
adres = Range(adr).SpecialCells(xlCellTypeFormulas, 16).Address
For Each hucre In Range(adres)
If hucre.Offset(0, -1) = 0 Then GoTo 10
son = s1.[e65536].End(3).Row + 1
s1.Cells(son, "b") = hucre.Offset(0, -4)
s1.Cells(son, "c") = hucre.Offset(0, -3)
s1.Cells(son, "d") = hucre.Offset(0, -2)
s1.Cells(son, "e") = hucre.Offset(0, -1)
10 Next
Set t1 = Sheets("ARALIK-AKTAR")
adr = "p6:p" & [o65536].End(3).Row
adres = Range(adr).SpecialCells(xlCellTypeFormulas, 16).Address
For Each hucre In Range(adres)
If hucre.Offset(0, -1) = 0 Then GoTo 20
son = t1.[k65536].End(3).Row + 1
t1.Cells(son, "H") = hucre.Offset(0, -4)
t1.Cells(son, "I") = hucre.Offset(0, -3)
t1.Cells(son, "J") = hucre.Offset(0, -2)
t1.Cells(son, "K") = hucre.Offset(0, -1)
20 Next
MsgBox "VERİLER AKTARILDI"
End Sub

kasif2 · 29 Ocak 2006

Ãimdi ufak bir sorun kaldı, ARALIK-AKTAR sayfasında örneğin 1e2 sil dediğim zaman aşağıdaki kod ile örneğin 1. değere baktı bulamadı, 2. değere baktı bulamadı, 3. değerde sağlayan iki değeri buldu ve bu parayı sildi. Daha sonra tekrar 1. değeri aramaya geri dönüyor. Aramaya tekrar en baştan başlamaktansa kaldığı yerden devam etmesini nasıl sağlayabilirim...
Eski kod:

Kod:

Sub sil_1e1()
For x = 5 To [E65536].End(3).Row
For y = 5 To [K65536].End(3).Row
If Cells(x, 5) = Cells(y, 11) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e1
End If
Next y, x
End Sub
Sub sil_1e2()
For x = 5 To [E65536].End(3).Row
For y = 5 To [K65536].End(3).Row - 1
For z = y + 1 To [K65536].End(3).Row
Union(Cells(x, 5), Cells(y, 11), Cells(z, 11)).Select
If Cells(x, 5) = Round(Cells(y, 11) + Cells(z, 11), 0) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e2
End If
Next z, y, x
End Sub
Sub sil_1e3()
For x = 5 To [E65536].End(3).Row
For y = 5 To [K65536].End(3).Row - 2
For z = y + 1 To [K65536].End(3).Row - 1
For t = z + 1 To [K65536].End(3).Row
Union(Cells(x, 5), Cells(y, 11), Cells(z, 11), Cells(t, 11)).Select
If Cells(x, 5) = Round(Cells(y, 11) + Cells(z, 11) + Cells(t, 11), 2) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & t & ":K" & t).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
Call sil_1e3
End If
Next t, z, y, x
End Sub

Levent Menteşoğlu · 29 Ocak 2006

Ã?rneğin "1 e sil2" isimli prosedürünüzü aşağıdaki gibi değiştirerek deneyin.

[vb:1:f6e3b71ca6]Sub sil_1e2()
son = [E65536].End(3).Row
10 For x = son To 5 Step -1
For y = [K65536].End(3).Row - 1 To 5 Step -1
For z = [K65536].End(3).Row To y + 1 Step -1
Union(Cells(x, 5), Cells(y, 11), Cells(z, 11)).Select
If Cells(x, 5) = Round(Cells(y, 11) + Cells(z, 11), 0) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
son = x
GoTo 10
End If
Next z, y, x
End Sub[/vb:1:f6e3b71ca6]

kasif2 · 29 Ocak 2006

Maalesef, tarama işlemini yapıyor fakat verdiğiniz kod 1e2 sağlayan satırları silme işlemini yapmıyor...

Bir de YOKAKTAR şu satırda bazen hata veriyor, nedenini anlamadım...

Kod:

Hata:
Runtime error'1004'

Method'Range' of object '_Global' failed

Hata veren satır:
For Each hucre In Range(adres)

Levent Menteşoğlu · 29 Ocak 2006

Kodu aşağıdaki gibi deneyin.

[vb:1:fc5ae753ca]Sub sil_1e2()
basla = 5
10 For x = basla To [E65536].End(3).Row
For y = 5 To [K65536].End(3).Row - 1
For z = y + 1 To [K65536].End(3).Row
Union(Cells(x, 5), Cells(y, 11), Cells(z, 11)).Select
If Cells(x, 5) = Round(Cells(y, 11) + Cells(z, 11), 0) Then
Range("A" & x & ":E" & x).Delete shift:=xlUp
Range("G" & z & ":K" & z).Delete shift:=xlUp
Range("G" & y & ":K" & y).Delete shift:=xlUp
basla = x
GoTo 10
End If
Next z, y, x
End Sub
[/vb:1:fc5ae753ca]

Levent Menteşoğlu · 29 Ocak 2006

adr = "f6:f" & [E65536].End(3).Row

adr = "p6

" & [o65536].End(3).Row

Yukarıdaki satırları aşağıdakiler ile değiştirerek deneyin.

adr = "f6:f" & [d65536].End(3).Row

adr = "p6

" & [n65536].End(3).Row

kasif2 · 29 Ocak 2006

leventm' Alıntı:
adr = "f6:f" & [d65536].End(3).Row

adr = "p6" & [n65536].End(3).Row

Hata veren satır:
For Each hucre In Range(adres)
Aynı hatayı yine verdi.

Ayrıca 1e2 formülü silme işlemini yine yapmadı. Bir de çok yavaşladı. [k65536]yı [k400] yapıyorum, daha hızlı çalışıyor.

Levent Menteşoğlu · 29 Ocak 2006

Verdiğim her iki kodda doğru çalışıyor bir hata vermedi, ekteki dosyayı inceleyin.

kasif2 · 29 Ocak 2006

Gönderdiğin tabloda 1 e 2 karşılayan para yok, örneğin E7'yi 27.947,07 yaptım, sağdaki tabloda K8+K9'un toplamı da 27.947,07 olduğu halde silmedi, ama kuruş hanesi 00 ise oluyor. Mesela K18+K31 toplamı olan 70.553,00'ı E7'ye yazdığımda bu şekilde götürdü, ama kuruş hanesinde para varsa silmiyor.

Levent Menteşoğlu · 29 Ocak 2006

If Cells(x, 5) = Round(Cells(y, 11) + Cells(z, 11), 0) Then

Yukarıdaki satırı aşağıdaki ile değiştirin.

If Cells(x, 5) =Cells(y, 11) + Cells(z, 11) Then

kasif2 · 29 Ocak 2006

Teşekkürler leventm :dua2: ,

If Cells(x, 5) = Round(Cells(y, 11) + Cells(z, 11), 2) Then
şeklinde değiştirdim, düzeldi. Eskiden her bulduğu değerden sonra başa dönüyor, boş hücrelerde bile tarama yapıyor, bazen de döngü bir ileri bir geri sarıp bir türlü durmuyordu.

Vermiş olduğun eklenti sorunu çözdü.

kasif2 · 29 Ocak 2006

Bir de şu hata olmasa, çok fazla para olduğunda mı neden bu hatayı veriyor anlamadım. Bazen izmir, bazen ankara için hata veriyor. Aşağıdaki tabloda ankara'da hata veriyor.

Hata satırı: For Each hucre In Range(adres)

Levent Menteşoğlu · 29 Ocak 2006

Aşağıdaki gibi deneyin.

[vb:1:99f2400c6f]Sub YOKAKTAR()
Set s1 = Sheets("ARALIK-AKTAR")
adr = "f6:f" & [d65536].End(3).Row
adres = Range(adr).SpecialCells(xlCellTypeFormulas, 16).Address
For Each hucre In Range(adres)
If hucre.Offset(0, -1) = 0 Then GoTo 10
son = s1.[E65536].End(3).Row + 1
s1.Cells(son, "b") = hucre.Offset(0, -4)
s1.Cells(son, "c") = hucre.Offset(0, -3)
s1.Cells(son, "d") = hucre.Offset(0, -2)
s1.Cells(son, "e") = hucre.Offset(0, -1)
10 Next
adr2 = "p6

" & [n65536].End(3).Row
adres2 = Range(adr).SpecialCells(xlCellTypeFormulas, 16).Address
For Each hucre2 In Range(adres2)
If hucre2.Offset(0, -1) = 0 Then GoTo 20
son = s1.[K65536].End(3).Row + 1
s1.Cells(son, "H") = hucre2.Offset(0, -4)
s1.Cells(son, "I") = hucre2.Offset(0, -3)
s1.Cells(son, "J") = hucre2.Offset(0, -2)
s1.Cells(son, "K") = hucre2.Offset(0, -1)
20 Next
MsgBox "VERİLER AKTARILDI"
End Sub
[/vb:1:99f2400c6f]

kasif2 · 30 Ocak 2006

Sn. Leventm;

Formül size göndermiş olduğum tabloda işe yaradı ama tablonun aslında yine aynı hatayı verdi, nedenini anlamadım.

Sayfa1'deki düşeyara'da #YOK çıkan satırları tablo2'ye

kasif2

TRABLUS

Misafir

kasif2

TRABLUS

Misafir

kasif2

Levent Menteşoğlu

Administrator

kasif2

kasif2

Levent Menteşoğlu

Administrator

kasif2

Levent Menteşoğlu

Administrator

Levent Menteşoğlu

Administrator

kasif2

Levent Menteşoğlu

Administrator

kasif2

Levent Menteşoğlu

Administrator

kasif2

kasif2

Levent Menteşoğlu

Administrator

kasif2