• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Çalışma sayfasında Belirli Hücre Aralıklarındaki Verilerin Yerini değiştirme

Katılım
27 Ağustos 2013
Mesajlar
213
Excel Vers. ve Dili
Office 2019 Pro
Türkçe
Merhabalar. Örnek olarak hazırladığım dosya da B5:D sütun aralığındaki verilerin I5:K Sütun aralığındaki verilerle yer değiştirmesi gerekmekte. Bunu bir butona bağlı şekilde nasıl yapabilirim?

Not:1 Veriler 5. satırdan itibaren başlıyor. Ancak kaçıncı satırda biteceği belirli değil(200 ü geçmez muhtemelen). O nedenle otomatik kontrolünün yapılması gerekiyor.
Not:2 kenarlıkların veri girildiği sürece otomatik eklenmesi mümkün müdür? İyi günler Dilerim.
 

Ekli dosyalar

Deneyiniz..

Kod:
Sub Yer_Degistir()
    Dim Son1, Son2, Rng1, Rng2
    Son1 = Cells(Rows.Count, "D").End(3).Row: Son2 = Cells(Rows.Count, "I").End(3).Row
    Rng1 = Range(Cells(5, 2), Cells(Son1, 4)).Value: Rng2 = Range(Cells(5, 9), Cells(Son2, 11)).Value
    Range(Cells(5, 2), Cells(Son1, 4)).ClearContents: Range(Cells(5, 9), Cells(Son2, 11)).ClearContents
    Range(Cells(5, 2), Cells(Son2, 4)).Value = Rng2: Range(Cells(5, 9), Cells(Son1, 11)).Value = Rng1
    Range(Cells(5, 2), Cells(Son1, 4)).Borders.LineStyle = xlNone: Range(Cells(5, 9), Cells(Son2, 11)).Borders.LineStyle = xlNone
    Range(Cells(5, 2), Cells(Son2, 4)).Borders.LineStyle = xlContinuous: Range(Cells(5, 9), Cells(Son1, 11)).Borders.LineStyle = xlContinuous
End Sub
 
Son düzenleme:
@EmrExcel16 Merhabalar. İlgilendiğiniz için teşekkürler. Formül Çalıştı. Ancak kenarlık problemini nasıl çözebilirim?
 
Not: Smile nedeniyle ilk mesajıdma hata olmuş. B5: D Aaralığı olacak.
 
@EmrExcel16 Merhabalar. Evet şimdi istediğim gibi oldu teşekkürler. Tabi sizin formülünzden bağımsız oalrak kendi dosyamda şöylşe bir sıkıntı ile karşılacaşağım haliyle.

Yeni Eklediğim örnek dosya da. B: D Aralığı ile I: K aralığı farklı uzunluklarda olabilir(dolu satır olarak). Örneğin P5 hücresindeki formülümü o bahsettiğim aralıklardan en kısa hangisiyse o kadar formülü aşağıya kadar nasıl kopyalarım(fare ile formülü aşağıya çekiyormuş gibi)


 

Ekli dosyalar

Eğer ve EBoşsa formülleri ile tek bir aralığa göre(Örneğin B Sütununa göre) yapmasını biliyorum. Ama burada aralıkların uzunluğu kısa sürekli değişecek eklenen verilere göre. O nedenle kendim çözemedim. Asıl dosyamda İndis ve Kaçıncı formüllerini kullandığım için hayliyle formülün boş olan hücreye başvurması sıkıntı oluşturuyor.
 
Son düzenleme:
Merhaba , rica ederim , yeni isteklerinizi ben tam olarak anlayamadım , anlayan arkadaşlar yardımcı olacaklardır.
 
@EmrExcel16 Son yüyklediğim dosya da P sütunundaki formülüm B: D Ve I: K aralığındaki noktaların birbirine olan uzaklığını hesaplıyor. P sütunundaki formülün otomatik olarak aşağıya doğru kopyalanması gerekiyor.(Fare ile aşağıya çekiyor gibi). Bunu yaparken Örneğin B sütunun satır uzunluğu ve I sütununun satır uzunluğu(Dolu ooalrak) karşılaştırılıp hangisinin satır uzunluğu kısaysa o kadar p sütununda P5 hücresinden itibaren formülün aşağıa doğru kopyalanması gerekiyor.
 
Böyle bir şey mi istiyorsunuz ..

Kod:
    If Son1 < Son2 Then
        Range("P5").AutoFill Destination:=Range("P5:P" & Son1), Type:=xlFillDefault
    Else
        Range("P5").AutoFill Destination:=Range("P5:P" & Son2), Type:=xlFillDefault
    End If
 
@EmrExcel16 Evet aradığım kod bu çok teşekkür ederim.

Son yazdığınız kodla alakalı bir kaç yerde daha benzerlerine ihtiyacım olacak. Yardımcı olabilir misiniz?
1-P5 hücresini aşağıya doğru değilde sağ tarafa doğru otomatik kopyalanmasını nasıl sağlarım?
2-Aynı şekilde P5 Hücresindeki formülü hem aşağıya hem sağ tarafa doğru nasıl kopyalarım?
3-Örnek dosyada yok ama N5,O5,P5 Birbiriyle bağlantılı hücreler. Bunları 3 lü grup şeklinde , hem aşağıya hem yana doğru nasıl kopyalarım?

Not:1 Aşağıya doğru kopyalama uzunluğunu zaten verdiğiniz kod sağlıyor. Sağ tarafa Kopyalama uzunluğu B sütunundaki B5 ve devamındaki dolu hücrelere göre olacaktır.
 
Bu şekilde çoğaltılabilir..

Kod:
Range("P5").AutoFill Destination:=Range("P5:Z5"), Type:=xlFillDefault ' P5 deki formülü sağa doğru (Z5) çoğaltır
Range("P5:Z5").AutoFill Destination:=Range("P5:Z10"), Type:=xlFillDefault ' P5 ile Z5 arasındaki formülü P5:Z10 arasında çoğaltır
 
@EmrExcel16 yardımcı olduğunuz için teşekkürler. Siz yazmadan önce

Kod:
Range("P5").AutoFill Destination:=Range("P5:Z5" & Son1), Type:=xlFillDefault
Şu kodu denemiştim ama bu kod P sütunu boyunca kopyalıyor.(P sütunu kaç milyon satırsa artık:D)

Bu kopyalamanın uzunluğunu nasıl belirlerim?

Konuda ki 11. mesajda bunu son1 ve son2 ye göre ayarlamıştınız.

Dosyayı ekte paylaştım şöyle bir sıkıntı oluyor.
Aşağı doğru kopyalamanın sınırı daha önce ayarladığınız gibi son1(B5 ten itibaren B5 sütunundaki dolu hücre kadar) ve son2(I5 ten itibaren I sütıunundaki dolu hücre kadar) göre olacak. Ama Sağa doğru kopyalamanın sınırı ise son 1 e göre olacak
 

Ekli dosyalar

Deneyiniz..

Kod:
Sub Yer_Degistir()
    Dim Son1, Son2, Rng1, Rng2
    Son1 = Cells(Rows.Count, "B").End(3).Row: Son2 = Cells(Rows.Count, "I").End(3).Row
    Rng1 = Range(Cells(5, 2), Cells(Son1, 4)).Value: Rng2 = Range(Cells(5, 9), Cells(Son2, 11)).Value
    Range(Cells(5, 2), Cells(Son1, 4)).ClearContents: Range(Cells(5, 9), Cells(Son2, 11)).ClearContents
    Range(Cells(5, 2), Cells(Son2, 4)).Value = Rng2: Range(Cells(5, 9), Cells(Son1, 11)).Value = Rng1
    Range(Cells(5, 2), Cells(Son1, 4)).Borders.LineStyle = xlNone: Range(Cells(5, 9), Cells(Son2, 11)).Borders.LineStyle = xlNone
    Range(Cells(5, 2), Cells(Son2, 4)).Borders.LineStyle = xlContinuous: Range(Cells(5, 9), Cells(Son1, 11)).Borders.LineStyle = xlContinuous
    
    Range(Cells(5, 16), Cells(Cells(Rows.Count, 16).End(3).Row, Cells(5, Columns.Count).End(1).Column)).ClearContents
    Range("P5").FormulaR1C1 = "=SQRT((R1C-RC10)^2+(R2C-RC11)^2)"
    
    If Son1 < Son2 Then
        Range("P5").AutoFill Destination:=Range(Cells(5, 16), Cells(5, 16 + Son1)), Type:=xlFillDefault
        Range(Cells(5, 16), Cells(5, 16 + Son1)).AutoFill Destination:=Range(Cells(5, 16), Cells(Son1, 16 + Son1)), Type:=xlFillDefault
    Else
        Range("P5").AutoFill Destination:=Range(Cells(5, 16), Cells(5, 16 + Son2)), Type:=xlFillDefault
        Range(Cells(5, 16), Cells(5, 16 + Son2)).AutoFill Destination:=Range(Cells(5, 16), Cells(Son2, 16 + Son2)), Type:=xlFillDefault
    End If
    
End Sub
 
@EmrExcel16
Merhabalar. Kodu denedim ancak istediğim gibi çalışmadı. A5 hücresindeki butona verdiğiniz kodu ekledim. Bu sayede gurupların yer değiştirmesini sağlayabiliyorum. Önekteki dosya da Grup 1 15 satır uzunluğunda Grup 2 ise 40 satır uzunluğunda.

Bu arada asıl dosyamı örneklerken bir formülü yanlış kullandığımdan istediğim şeyi yanlış anlatmışım kusura bakmayın. Şimdi istediğim şeyin doğru halini anlatıyorum.

P5 Hücresindeki formülün hem sağa doğru hem aşağıya doğru kopyalanması gerekmekte.
1-Şimdi P5 hücresindeki formülü aşağıya doğru kopyalarken. Uzunluğu I5 ve devamındaki I sütunu boyunca olan dolu hücreler kadar olacak.(Örnek dosyaya göre 15 satır(Sol taraftaki grup kaç satırsa artık))
2-P5 hücresindeki formülü Sağa doğru kopyalarken Uzunluğu B5 ve devamındaki B sütunu boyunca olan dolu hücreler kadar olacak.(Örnek dosyaya Göre 40 sütun-Sağ taraftaki gurup kaç satırsa artık))
 

Ekli dosyalar

Son düzenleme:
Estağfurullah , rica ederim güle güle kullanın , iyi çalışmalar. :)
 
Geri
Üst