Dolu alan hücreleri seçmek

Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Merhaba arkadaşlar,

B1 hücresinden başlayarak nerde nerde bittiği belli olmayan yani X2 ye kadar olan dolu hücreleri seçip B5 hücresinden itibaren transpoze olarak kopyalayacak. daha sonrada A5 hücresinden başlayarak B kolonunun son dolu hücresine kadar A koloununa bir hücresine toplam altındakine de miktar yazmasını istiyorum. Yardımcı olursanız çok makbule geçecek.
 

Ekli dosyalar

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,472
Excel Vers. ve Dili
Office 2010 & 2013 tr
Merhaba,
Dosyanızdaki kodu aşağıdaki ile değiştirin.
Kod:
Sub dene()
Application.ScreenUpdating = False
For x = 2 To Cells(1, 256).End(1).Column Step 2
Range(Cells(1, x), Cells(1, x + 1)).MergeCells = False
Cells(1, x + 1) = Cells(1, x)
Cells(x + 3, 2) = Cells(1, x)
Cells(x + 3, 1) = "TOPLAM"
Cells(x + 4, 2) = Cells(1, x)
Cells(x + 4, 1) = "ADET"
Cells(x + 3, 2) = Cells(2, x)
Cells(x + 4, 2) = Cells(2, x + 1)
Next
Application.ScreenUpdating = True
End Sub
 
Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Üstadım elinize sağlık çok teşekkür ederim fakat B kolonuna isimler,C kolonundada rakamlar olamalı. Rica etsem kodu anlatmanız mümkünmü? Ben sorumu sırası ile sorup kodları anlayarak bu işi bitirmek istedim fakat siz yapmak iistediğim kökten çözdünüz. Dosyam ekde
 

Ekli dosyalar

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,472
Excel Vers. ve Dili
Office 2010 & 2013 tr
Kod:
Sub dene()
Application.ScreenUpdating = False
For x = 2 To Cells(1, 256).End(1).Column Step 2
Range(Cells(1, x), Cells(1, x + 1)).MergeCells = False
Cells(1, x + 1) = Cells(1, x)
Cells(x + 3, 2) = Cells(1, x)
Cells(x + 3, 1) = "TOPLAM"
Cells(x + 4, 2) = Cells(1, x)
Cells(x + 4, 1) = "ADET"
Cells(x + 3, 3) = Cells(2, x)
Cells(x + 4, 3) = Cells(2, x + 1)
Next
Application.ScreenUpdating = True
End Sub
Bu satırda 2 sütundan başlayarak son dolu sütuna doğru bir döngü başlatıyoruz. Step 2 tanımı ise bu döngünün 2'şer 2'şer ilerlemesini sağlıyor.
Kod:
For x = 2 To Cells(1, 256).End(1).Column Step 2
Burada ise birleşik olan hücre aralığını açıyoruz. Örneğin x döngüsü 4'de gelmiş olsun. Biz bu kodla 4 ve 5. sütuna denk gelen hücre aralığını açıyoruz.
Kod:
Range(Cells(1, x), Cells(1, x + 1)).MergeCells = False
Burada ise dikkat etmeniz gereken x döngüsünü kullandığım kısımlar. Siz ters çevirerek almamızı istediğinizden x'i satır kısmına aldım. Döngü 2 den başladığından ve siz de 5. satırdan aktarmamı istediğinizden 3 sayı ekledim ve x+3 5. satıra denk gelmiş oldu. Döngü 2'den 4'e atlayarak gittiğinden, sizde de yazılması gereken 2 isim olduğundan x+3'e veriyi yerleştirdikten sonra x+4 ile bir sonraki hücreye veriyi yazdırdım.
Kod:
Cells(1, x + 1) = Cells(1, x)
Cells(x + 3, 2) = Cells(1, x)
Cells(x + 3, 1) = "TOPLAM"
Cells(x + 4, 2) = Cells(1, x)
Cells(x + 4, 1) = "ADET"
Cells(x + 3, 3) = Cells(2, x)
Cells(x + 4, 3) = Cells(2, x + 1)
Umarım anlaşılmıştır.
 
Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Çok teşekkür ederim üstadım. Bende sizin kodlardan çıkardığım kadarı ile eksik kısmı kendime göre düzenledim ama üstadın yaptığı daha farklı tabii.
Sub MERGE()
Application.ScreenUpdating = False
For x = 2 To Cells(1, 256).End(1).Column Step 2
Range(Cells(1, x), Cells(1, x + 1)).MergeCells = False
Cells(1, x + 1) = Cells(1, x)
Next
Application.ScreenUpdating = True
End Sub
Sub TRANSPOZE()
For x = 2 To Cells(1, 256).End(1).Column Step 1
For t = 2 To Cells(1, 256).End(1).Column Step 2
Cells(x + 3, 2) = Cells(1, x)
Cells(x + 3, 3) = Cells(2, x)
Cells(t + 3, 1) = "TOPLAM"
Cells(t + 4, 2) = Cells(1, t)
Cells(t + 4, 1) = "ADET"

Next t
Next x
End Sub
Sub GORUNTU()
MERGE
TRANSPOZE
End Sub
Tekrar teşekkür ederim iyi geceler
 

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,472
Excel Vers. ve Dili
Office 2010 & 2013 tr
Çok teşekkür ederim üstadım. Bende sizin kodlardan çıkardığım kadarı ile eksik kısmı kendime göre düzenledim ama üstadın yaptığı daha farklı tabii.
Tekrar teşekkür ederim iyi geceler
Estağfirullah, rica ederim. Kendinizin bir şeyler yapmaya çalışması öğrenmek için daha faydalı. Sizinki de pek güzel olmuş, elinize sağlık.:)
 
Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Sub MERGE()
Application.ScreenUpdating = False
Application.ScreenUpdating = True
End Sub
Sub MERGE()
Application.ScreenUpdating = False
kod aralığında kullanmamızın anlamı ne acaba
Application.ScreenUpdating = True
End Sub
Application.ScreenUpdating = False ve True yu kod aralığında kullanmamızın anlamı ne?
 

leumruk

Uzman
Uzman
Katılım
15 Nisan 2007
Mesajlar
3,472
Excel Vers. ve Dili
Office 2010 & 2013 tr
İşlem yaparken ekranın titremesini engellemeye yarar. Kısaca şöyle açıklayayım. İşlemi yapar; ancak yapılan işlemleri tek tek göstermez. Size sadece sonucu verir.
 
Son düzenleme:
Katılım
28 Kasım 2007
Mesajlar
919
Excel Vers. ve Dili
Office 2010 İngilizce
Teşekkür ederim
 
Üst