A sayfasında Koşulu sağlayan veriler B sayfasında 11-44 satırlar arasında önce a,b,e

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
A 'da Koşulu sağlayan verileri B ' de 11-44 satırlararasındailgilisütunlara aktarmak?

günlük (a) sayfasının a sütununda ev yazan hücre varsa A sayfasının c,d,e sütunlarını b sayfasının 11. satır ile 44. satır arasında a, b, e sütunlarına kopyala
e44 dolduğunda g,h,k sütunlarına yazmaya devam et....
k44 dolduğunda lütfen yeni sayfadan devem ediniz diyerek mesaj gönder


Ripek hocamın yaptığı kodlar a,b,e sütunlarını doldurmamda işe yarıyor... ben g,h,k için geliştiremedim.
Yardım ederseniz sevinirim.
Kodlarınızı aşağıdaki şekilde değiştirerek deneyiniz.

Kod:
For g = 3 To 120           'günlük sayfası döngü
       If Sheets("günlük").Cells(g, 1) = "Ev" Then 'Günlük sayfasının A sütununda 3 nolu satırdan 120 nolu satıra kadar "ev" yazıyorsa
            e = Sheets("tsb").[b45].End(3).Row + 1
                If e = 45 Then
                MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
                Exit Sub
                End If
                  Sheets("tsb").Cells(e, 1) = Sheets("günlük").Cells(g, 3)  'Fiş No        ' tsb a sütununa günlük c sütununu
                  Sheets("tsb").Cells(e, 2) = Sheets("günlük").Cells(g, 4)  'Adı Soyadı    ' tsb c sütununa günlük d sütununu
                  Sheets("tsb").Cells(e, 5) = Sheets("günlük").Cells(g, 5)  'Tutarı        ' tsb e sütununa günlük e sütununu yaz
         End If
   Next
 
Son düzenleme:
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Dosyamıda ekledim veresiye, tahsilat kısmınıda beceremedim, 12,2,24,45 i becerdi, ama 12 yi genişletemedim... yardım lütfen
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
güncel... yardımlarınız bekliyorum
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
yardım ederseniz sevinirim... hayırlı bayramlar
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
güncel... yardımlarınız bekliyuorum
saygılarımla
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
güncel... yardımlarınızı bekliyorum
saygılarımla
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Aşağıdaki kodu deneyin.

Kod:
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Ev" Then
c = c + 1
If c = 35 Then
sut = 6
c = 1
End If
If WorksheetFunction.CountA(s2.[e11:e44,k11:k44]) = 68 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 1 + sut) = s1.Cells(g, 3)
s2.Cells(c + 10, 2 + sut) = s1.Cells(g, 4)
s2.Cells(c + 10, 5 + sut) = s1.Cells(g, 5)
End If
Next
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
sayın leventm ilginizeteşekkür ederim. ev tüplerinin 2. kolana yyılmasında işe yaradı

bir şey soracağım bordromuz iki sayfa olsun ve k44 dolduğunda e57:e90 a sonrada g57:g90 aralığında devam edecekse

If WorksheetFunction.CountA(s2.[e11:e44,k11:k44]) = 68 Then

satırını

If WorksheetFunction.CountA(s2.[e11:e44,k11:k44,e57:e90,k57:k90]) = 136 Then

olarak mı düzeltmeliyim.


Bu kodalrı ben veresiye / tahsilat /lokanta /sanayi alanlarına genişletmedim daha yeni gördüm test edip bilgi veririm.

Saygılarımla
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Bunu söylemek zor, dosyanızı o aşamaya getirince kodu tekrar düzenleriz.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Kod:
Private Sub CommandButton1_Click()
temizle         'bordro sayfasını sıfırlar
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>ev
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Ev" Then
c = c + 1
If c = 35 Then
sut = 6
c = 1
End If
If WorksheetFunction.CountA(s2.[e11:e44,k11:k44]) = 68 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 1 + sut) = s1.Cells(g, 5)
s2.Cells(c + 10, 2 + sut) = s1.Cells(g, 4)
s2.Cells(c + 10, 5 + sut) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<ev

'>>>>>>>>>>>>>>>>>>>>>>>>>piknik
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Piknik" Then ' And "piknik" Then
c = 0 '<<<=====================
c = c + 1
If c = 35 Then
'sut = 6
c = 1
End If
If WorksheetFunction.CountA(s2.[q11:q44]) = 34 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 13) = s1.Cells(g, 5)
s2.Cells(c + 10, 14) = s1.Cells(g, 4)
s2.Cells(c + 10, 17) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<piknik
End Sub
hocam piknik için geliştirmeye çalıştığımda c=c+1 hali ile ev tüpte kaçıncı satırda kaldı ise piknik tüpte o satır +1 den devam ediyor

yani
ev tüpü en son g,h,k sütunlarının 14 .satırına yazdı ise
pikniği m,m,q sütunlarının 15 .satırından itibaren listeliyor ama bunlarıda 11den itibaren yapması lazım.

c=0 diyerek c yi sıfırlarsam sadece yazılan son pikniği geliyor mnq 11 e koyuyor

nasıl geliştirmeliyim.
 

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
c=0 ifadesini ikinci d&#246;ng&#252;den &#246;nce koyarak deneyin.
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
pardon hocam aktarmak i&#231;in kulland&#305;&#287;&#305;n&#305;z
'If c = 35 Then sut = 6 : c = 1 : End If
sat&#305;rlar&#305; engelliyormu&#351; &#231;&#246;zd&#252;m zahmet etmeyin
 
Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
Levent hocam ellerinize sağlık ben yaptım ve düzenledim ama siz ne diyeceksiniz daha seri nasıl çalışır gibi düşüncelerinizi öğrenmek için kodaları tekrar ekledim... (pc kasmış vaziyette uydu down açık)

butona
Kod:
Private Sub CommandButton1_Click()
temizle         'bordro sayfasını sıfırlar
ev              'ev tüpleri sütununa yazar
piknik          'piknik tüpleri sütununa yazar
Lokanta         'lokanta tüpleri sütununa yazar
Sanayi          'sanayi tüpleri sütununa yazar
Veresiye        'veresiye işlemlerini sütununa yazar
Tahsilat        'tahsilat işlemlerini sütununa yazar
End Sub
modüle
Kod:
Sub temizle()
'
' temizle Makro
' Makro CASPER tarafından 10.10.2007 tarihinde kaydedildi.
'
    Sheets("Tsb").Select
    Range("A11:F44").Select
    Selection.ClearContents
    Range("g11:l44").Select
    Selection.ClearContents
    Range("m11:r44").Select
    Selection.ClearContents
    Range("s11:x23").Select
    Selection.ClearContents
    Range("s32:x44").Select
    Selection.ClearContents
    Range("y11:ad44").Select
    Selection.ClearContents
    Range("ae11:aj44").Select
    Selection.ClearContents
    
End Sub

Sub ev()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>ev
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Ev" Then
c = c + 1
If c = 35 Then
sut = 6
c = 1
End If
If WorksheetFunction.CountA(s2.[e11:e44,k11:k44]) = 68 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 1 + sut) = s1.Cells(g, 5)
s2.Cells(c + 10, 2 + sut) = s1.Cells(g, 4)
s2.Cells(c + 10, 5 + sut) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub

Sub piknik()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>piknik
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Piknik" Then ' And "piknik" Then
'c = 0
c = c + 1
'If c = 35 Then sut = 6 : c = 1 : End If
If WorksheetFunction.CountA(s2.[q11:q44]) = 34 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 13) = s1.Cells(g, 5)
s2.Cells(c + 10, 14) = s1.Cells(g, 4)
s2.Cells(c + 10, 17) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub

Sub Lokanta()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>lokanta
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Lokanta" Then ' And "piknik" Then
'c = 0
c = c + 1
'If c = 35 Then sut = 6 : c = 1 : End If
If WorksheetFunction.CountA(s2.[w11:w23]) = 13 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 19) = s1.Cells(g, 5)
s2.Cells(c + 10, 20) = s1.Cells(g, 4)
s2.Cells(c + 10, 23) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub

Sub Sanayi()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>sanayi
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 1) = "Sanayi" Then ' And "piknik" Then
'c = 0
c = c + 1
'If c = 35 Then sut = 6 : c = 1 : End If
If WorksheetFunction.CountA(s2.[w32:w44]) = 13 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 31, 19) = s1.Cells(g, 5)
s2.Cells(c + 31, 20) = s1.Cells(g, 4)
s2.Cells(c + 31, 23) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub

Sub Veresiye()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>veresiye
For g = 3 To s1.[a65536].End(3).Row
If s1.Cells(g, 2) = "V" Then
'c = 0
c = c + 1
'If c = 35 Then sut = 6 : c = 1 : End If
If WorksheetFunction.CountA(s2.[ac11:ac44]) = 34 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 25) = s1.Cells(g, 3)
s2.Cells(c + 10, 26) = s1.Cells(g, 4)
s2.Cells(c + 10, 29) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub

Sub Tahsilat()
Set s1 = Sheets("günlük")
Set s2 = Sheets("tsb")
'>>>>>>>>>>>>>>>>>>>>>>>>>tahsilat
For g = 3 To s1.[B65536].End(3).Row
If s1.Cells(g, 2) = "T" Or s1.Cells(g, 2) = "t" Then
'c = 0
c = c + 1
'If c = 35 Then sut = 6 : c = 1 : End If
If WorksheetFunction.CountA(s2.[ai11:ai44]) = 34 Then
MsgBox "Tablo dolduğu için kayıt yapılamadı.", , "UYARI"
Exit Sub
End If
s2.Cells(c + 10, 31) = s1.Cells(g, 3)
s2.Cells(c + 10, 32) = s1.Cells(g, 4)
s2.Cells(c + 10, 35) = s1.Cells(g, 7)
End If
Next
'<<<<<<<<<<<<<<<<<<<<<<<<<
End Sub
fikirlerinizi bekliyorum saygılarımla emeğiniz için tekrar teşekkürler
 
Üst