• DİKKAT

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

Satır aralıklarındaki değerleri kopyalama

G

Gold_Savt

Katılım
5 Mart 2010
Mesajlar
227
Excel Vers. ve Dili
Ofis 2010 TR 32 Bit
Örneğin
F1-J1 aralığını F3-J3 aralığına
M1-Q1 aralığını M8-Q8 aralığına
AA1-AE1 aralığını AA5-AE5 aralığına
(Bu işlem çoğaltılabilir.)

yapıştırsın ancak sadece değerleri yapıştırması lazım.
Ayrıca sıfır ve boş hücrelerin değerleri tamamen boş kalmalı. Bunun için bir CommandButton atayabilir miyiz?
 
Merhaba @Gold_Savt
Deneyiniz.

Kod: 
Sub DEGER_KOPYALA()
kynk = Array("A2:F5", "M1:Q2", "AA1:AE1")
sat = Array(6, 7, 5)
sut = Array(2, 1, 3)
For b = 0 To UBound(kynk)
    Range(kynk(b)).Offset(sat(b) + Range(kynk(b)).Rows.Count - 1, sut(b)).Value = Range(kynk(b)).Value
Next
End Sub

Açıklama ise şöyle
Koddaki
kynk = .... satırında kopyalanacak alan adresleri yazılacak
sat = .... satırında alanların, yukarıdaki sırasına göre kaç satır aşağı/yukarı (aşağı için +, yukarı için - yazılmalı) yapıştırılacağı
sut=... satırında alanların, yukarıdaki sırasına göre kaç sütun sağa/sola (sağa için +, sola için - yazılmalı) yapıştırılacak. Kodu sayfadaki düğmeye bağlayıp kullanabilirsiniz.
 
Hepgel, teşekkür ederim. Rakam olarak sıfırların gelmemesini de sağlamam lazım. Nasıl bir değişiklik izlemeliyim, kodlarda.
 
İki kodda çalışıyor ancak "sıfır" değerlerinin yada "boş" değerlerin gelmemesi gerekiyor.
İki formülde de sıfır değerlerini de kopyaladığından işlem boşa gidiyor malesef.
 
Next satırından önce aşağıdaki satırları eklerseniz istenilen olur.

Kod: 
 For Each d In Range(kynk(b)).Offset(sat(b) + Range(kynk(b)).Rows.Count - 1, sut(b))
        If d = 0 Then d.Value = ""
    Next
 
Seyit Tiken, gizlemek oradaki sıfırı yok saymadığından çözüm olmadı.
Hepgel, eklemiş olduğunuz kod CommandButton da çalışmıyor sanırım.
Örnek dosya ekledim.
 

Ekli dosyalar

Dosyanız üzerinde denedim oldu(6.mesaj).
Hücrede sıfır(0) gizlemek için;
214358
 
Seyit Tiken hocam teşekkür ederim ilginiz için.
Sorun olan durum: sayfada sıfırın gizlenip gizlenmemesi değil.
Sorun olan durum: Aktardığım hücrelerde sıfır karakterinin varlığı. Yani sıfır rakamı değer olarakta kod olarakta orada hiç olmamalı.

Sıfırın gizlenmesi oradaki sıfırın varlığına engel olmadığından bir sonraki işlem gerçekleşmiyor.
BAĞ_DEĞ_DOLU_SAY dediğim zaman orada gizlenmiş bile olsa sıfırı değerden sayıyor ve işlemlerim hatalı çıkıyor.

Şöyle bir çözüm yolu var aslında:

Kod: 
If Worksheets("Sayfa1").Cells(1, 10) <> 0 Then
    Worksheets("Sayfa1").Cells(3, 10) = Worksheets("Sayfa1").Cells(1, 10)
Else
    Worksheets("Sayfa1").Cells(3, 10) = ""
End If

Bunun derdi de şu: Bir hücrenin kopyala-yapıştır olması için yukrdaki 5 satırı yazmak gerekiyor.
Elimde guruplar halinde toplamda 50 hücre kopyalanacak. :(
Üstelik kopyalanacak yer değiştiği anda herşey sil baştan olacak.

Çözümsüz kaldık sanırım.
 
Şöyle yapın birden fazla grup (satır) içeren bir örnek dosya paylaşın. Sonra bu dosyada yapmak istediğiniz işlemi açıklayın.

Böylece farklı bakış açısıyla çözümler gelebilir.
 
Birebir örnek dosyayı ve açıklamasını ekte sunuyorum hocam. umarım halledebiliriz.
 

Ekli dosyalar

Gerçek dosyanızda da renkleri kullanıyor musunuz? Eğer kullanıyorsanız aktarım daha kolay olacaktır.

Eğer ikinci satırda hep gün adları yazıyorsa yine kolay olacaktır. (AR2 hücresi boş ama AR3 mavi renkli bu koşulu bozuyor)

1. satırda formüllü hücrelerin değerlerini aktarabiliriz. Fakat K1-L1 gibi hücreler kuralı bozuyor.

Bana sorarsanız 1. satır formülse, sıfır ve boş değilse, 2. satırda gün adı yazıyorsa aktarma işlemi yapılması uygun görünüyor. Ama AR2 hücresine gün adı yazmalısınız.

Buna göre aşağıdaki kodu deneyebilirsiniz.

C++: 
Private Sub CommandButton1_Click()
    Dim Veri As Range
   
    For Each Veri In Range("F1:AP1")
        If Veri.HasFormula Then
            Veri.Offset(2, 0) = Empty
            If Veri.Value <> 0 And Veri.Value <> "" Then
                If Veri.Offset(1, 0) <> "" Then
                    Veri.Offset(2, 0) = Veri.Value
                Else
                    Veri.Offset(2, 0) = Empty
                End If
            End If
        End If
    Next
   
    MsgBox "Değerler aktarılmıştır.", vbInformation
End Sub
 
Eğer BAĞ_DEĞ_DOLU_SAY formülü ile sonuca ulaşamıyorsanız, şu formülü kullanınız.
Kod: 
=EĞERSAY(F1:AR1;">0")
 
Korhan Ayhan' Alıntı:
Gerçek dosyanızda da renkleri kullanıyor musunuz? Eğer kullanıyorsanız aktarım daha kolay olacaktır.

Eğer ikinci satırda hep gün adları yazıyorsa yine kolay olacaktır. (AR2 hücresi boş ama AR3 mavi renkli bu koşulu bozuyor)

1. satırda formüllü hücrelerin değerlerini aktarabiliriz. Fakat K1-L1 gibi hücreler kuralı bozuyor.

Bana sorarsanız 1. satır formülse, sıfır ve boş değilse, 2. satırda gün adı yazıyorsa aktarma işlemi yapılması uygun görünüyor. Ama AR2 hücresine gün adı yazmalısınız.

Buna göre aşağıdaki kodu deneyebilirsiniz.

C++: 
Private Sub CommandButton1_Click()
    Dim Adres As String, Veri As Range
  
    Adres = Cells(1, Columns.Count).End(1).Address(, 0)
  
    For Each Veri In Range("F1:" & Adres)
        If Veri.HasFormula Then
            If Veri.Value <> 0 And Veri.Value <> "" Then
                If Veri.Offset(1, 0) <> "" Then
                    Veri.Offset(2, 0) = Veri.Value
                Else
                    Veri.Offset(2, 0) = Empty
                End If
            End If
        End If
    Next
  
    MsgBox "Değerler aktarılmıştır.", vbInformation
End Sub
Genişletmek için tıkla ...

Sayın Korhan AYHAN; Bu işlem F1 de başlıyor AP1 de son bulması lazım. Kısıtlama şansımız var mı?
Birde aktarılan alanda yani 3. satırda önceki rakamların temizlenmesi lazım.
Şayet bunlar olursa problem çözülmüş olacak.


Sayın Seyit TİKEN; bu olacak diyorsunuz. :) Çok teşekkür ederim. ancak dediğim gibi
=EĞER(I3>0;TAMSAYI($L$3/BAĞ_DEĞ_DOLU_SAY($F3:$J3));0) Bu şekil bir sürü forül var. Uyarlamak zor olacak.
 
Son düzenleme:
Üstteki mesajımda ki kodu revize ettim. Tekrar deneyiniz.
 
Korhan AYHAN Teşekkür ederim hocam. Projenin bu kısmında sorun kalmamıştır. Elinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst