bir shetteki verileri belirlediğimiz kritere göre diğer sheette belli satırlara yaz

[u.L.a.s]

Merhabalar

Aşağıdaki resimlerde göründüğü Sheet2 A Sütunu B sütunu C Sütunu D sütunu E sütununda verilerim var. Bu verileri ben Sheet1 de belirli satırlara belirlediğim kritere göre yazdırmak istiyorum.

Şöyleki

Sheet1 e baktığımızda Asütununda bazı veriler var. Eğer ben Sheet1 boş bir yere yani o boş yer macro yazdığım yer olacak zaten. Eğerki 1 yazmışsam. gidecek Sheet2 deki A sütunundaki verileri sırayla Sheet1 deki A5 sütunundan başlayarak 10 satır atlayıp yazacak.

Yani. ben örneğin Sheet1 de macro yazdığım yer B1 hücresi olsun. ve oraya 2 yazayım. 2 yazdığım için gidecek Sheet2 de Bsütunundaki verilere. Sonra B1 deki 2001 i A5 e yazacak B2 de 2002 yi A15 e yazacak B3 deki 2003 ü A25 e yazacak ve böyle devam edecek. Aşağıda excel dosyasınıda indirip o dosya üstünde bunu gösterebilirsiniz.

Teşekkürler şimdiden

http://s3.dosya.tc/server28/yesiJn/sayi.xlsx.html

 

[mersilen]

Merhaba
deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
Set s1 = Worksheets("Sheet1")
Set s2 = Worksheets("Sheet2")
If Intersect(Target, s1.Cells(1, "B")) Is Nothing Then Exit Sub
x = 5
sut = Target.Value
For i = 1 To s2.Cells(Rows.Count, sut).End(3).Row
   s1.Cells(x, "A") = s2.Cells(i, sut).Value
   x = x + 10
Next i

End Sub

 

[u.L.a.s]

Bu kodları Excel 2010 da nereye yazacağım. VBA diye bir arayüz geliyordu fakat nasıl açıldığını unuttum

 

[turist]

Bu kodları Excel 2010 da nereye yazacağım. VBA diye bir arayüz geliyordu fakat nasıl açıldığını unuttum

ALT tuşuna basılı tutarken ve F11 tuşuna birlikte basın, VBA penceresi açılır.

 

[u.L.a.s]

mersilen çok teşekkürler çok güzel çalışıyor.

turist verdiğin bilgi için sanada ayrıca teşekkür ederim.

istediğim gibi girdiğim değere göre veriler yerli yerine oturuyor.

Fakat 2. bir kriterim daha var. çalıştığım excel sayfasında bir yerde connected veya notconnect olma durumu var. eğer connected ise 5. satıra bu değeri yazmamalı. sadece notconnect değeri var ise yazmalı.

Bu connected veya notconnect durumuna 1. satırdan baksın. eğer notconnect ise zaten yukarıdaki gibi çalışsın. ama connected ise farklı bir sheetten farklı bir veri getirmesi gerekiyor örneğin sheet3 ten A3 hücresindeki veriyi yazsın.

 

[u.L.a.s]

Online olan arkadaşlar

Yukarıdaki kodlara ek 5. Postta yazdığım gibi olmasını istiyorum yardımcı olamaz mısınız acaba?

 

[mersilen]

C Sütununda 5-15-25-35 diye giden satırldaki hücrelere senin yazmış olduğun kodlamadaki gibi D1 hücresine 1 yazarsam gidip mac sheetinden A sütunundaki verileri dağıtıyor. 2 yazarsam B sütunundaki verileri dağıtıyor.
Ama tabi bunun için öncelikle her 5-15 diye giden satıra yerleşecek veri için B sütununda 1-11 diye giden hücreyi kontrol etmesi gerekiyor. Yani C5 Hücresine gelecek veri için B1 hücresinde "notconnect" ibaresi olması lazım. Eğer notconnect ibaresi varsa C5 hücresi gidip mac sheetinden ilgili verisini yazdırıyor. Eğerki B1 hücresinde "connected" ibaresi yazıyorsa işte o zaman mac hücresindeki veriyi almayacak. gidip "cf"sheetindeki A3teki veriyi yazdırıyor. ki onu yazması içinde hücrenin içinde o formül zaten yazılı "IF(B1="connected";cf!A3;ncf!D6)" şeklinde. Senin yapman gereken tek şey şu D hücresine 1 yazdığımda mac sheetinden A sütunundaki verileri C5-C15-C25 şeklinde dağııyor ya. bunu yapmadan önce B1-B11-B21 hücrelerinde "notconnect" olmasına bağlı yapsın. eğer notconnect yoksa zaten bişey yapmasın o hücredeki formül kendi işlevini görsün.

(Burada birbiriyle ilişkili hücreler aşağıdaki gibi)
B1-C5
B11-C15
B21-C25
B31-C35
B41-C45
.....
.....
.....
B241-C245
B251-C255

İşte bu kırmızı okla gösterdiğim gibi B11 hücresinde connected ibaresi var. Bu noktada artık senin yazdığın kod görevini yerine getirmeyecek yani mac sheetindeki veriyi getirmeyecek. onun yerine benim C15 hücresinde yazılı olan "IF(B11="connected";cf!A3;ncf!D6)" formülünü işletecek. ve C15 te yazması gereken veri "cf" sheetindeki A3 hücresi olacak.

Bu kodu deneyin

Private Sub Worksheet_Change(ByVal Target As Range)
Set s1 = Worksheets("switch1")
Set s2 = Worksheets("mac")
Set cf = Worksheets("cf")
If Intersect(Target, s1.Cells(1, "D")) Is Nothing Then Exit Sub

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
x = 5
sut = Target.Value
For i = 1 To s2.Cells(Rows.Count, sut).End(3).Row
         If s1.Cells(x - 4, 2) = "notconnect" Then
         s1.Cells(x, "C") = s2.Cells(i, sut).Value
         ElseIf s1.Cells(x - 4, 2) = "connected" Then
         s1.Cells(x, "C") = cf.Cells(3, "A").Value
         End If
x = x + 10
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub

 

[u.L.a.s]

Hocam emeğine sağlık

Yardımların için çok çok teşekkür ederim

 

[u.L.a.s]

Tekrar merhaba

çok ufak bir soru

bu kodu tamam vba yapıştırdım çalışıyor. Fakat excel dosyayı kapattığımda bu kodda kayboluor. tekrar açtığımda tekrar vba modu açıp bu kodları yapıştırmam gerekiyor.

Yada excel dosyayı başka bi yere taşısam ordada aynı şekilde vba modu açtığımda bomboşl geliyor tekrar bu kodları yapıştırmam gerekiyor.

 

[turist]

Tekrar merhaba

çok ufak bir soru

bu kodu tamam vba yapıştırdım çalışıyor. Fakat excel dosyayı kapattığımda bu kodda kayboluor. tekrar açtığımda tekrar vba modu açıp bu kodları yapıştırmam gerekiyor.

Yada excel dosyayı başka bi yere taşısam ordada aynı şekilde vba modu açtığımda bomboşl geliyor tekrar bu kodları yapıştırmam gerekiyor.

Dosyanızı VBA kodlarını ekledikten sonra SaveAs yaparak Excel Macro-Enabled Worksheet olarak kaydedin.(xlsm uzantılı olacaktır.xlsx olarak kaydedetmek istediğinizde size zaten ujyarı verecektir.)

 

[u.L.a.s]

Tamamdır şimdi oldu çok teşekkür ederim

imzan dikkatimi çekti bana 1 kod öğretene 40 yıl duacı olurum.

Aynen burda cevap veren herkese sonsuz teşekkürler.