Kopyala Kodlarındaki Boşlukları Değer Olarak Getirme

  • Konuyu başlatan Konuyu başlatan ErolU
  • Başlangıç tarihi Başlangıç tarihi
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...

ErolU

Katılım
28 Tem 2022
Mesajlar
300
Excel Versiyonu
Excel 2016
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Arkadaşlar,
Bir kopyala makrosu oluşturdum. Formüllü alanı kopyalayıp başka bir yere değer olarak yapıştırıyor.
Yapıştırdığı yerde boşluklar boş görünüyor ama bağ değ dolu say ile bakınca dolu görünüyor.
Bu sorunu çözmek istiyorum.
Yardımlarınızı rica ederim.

İnternette araştırdım şöyle bir kod ile çözülebiliyormuş. Bunu ekteki dosyaya nasıl entegre edebilirim? Varsa farklı bir çözüm de olur.

Kod: 
Alan=Range(...........)

For Each Veri In Alan
If Veri.Value = "" Then
Veri.ClearContents

End If: Next
 
VBA Tarih Filtreleme Sorununu Çözme
ListView ile Kriterlere Göre İki Tarih Arasını Süzme

Ekli dosyalar

Çözüm
Ömer BARAN
Bir de şöyle deneyin.

Copy yerine ilgili alandaki her hücre için;
-- hücre doluysa 93 satır üstündeki aynı sütun hücresine değeri yaz.
-- hücre boşsa (formül sonucu "" ise) 93 satır üstündeki hücre içeriğini temizle.

VBA: 
Sub Değeleri_Yapıştır()
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Sheets("SONUÇ").Unprotect
    
    For Each hcr In Sheets("SONUÇ").Range("C100:AM159, AT100:AX159")
        If hcr.Value <> "" Then hcr.Offset(-93, 0).Value = hcr.Value
        If hcr.Value = "" Then hcr.Offset(-93, 0).ClearContents
    Next
        
    Sheets("SONUÇ").Select: Range("E7").Activate
    Application.EnableEvents = True
    Application.Calculation =...
Tarihe göre sırala Oylamaya göre sırala
Belgenizin ThisWorkbook bölümündeki SelectionChange kodunun amacını anayamadım.
Bana gereksiz gibi geldiği için silinebilir gibi geldi.

Mevcut kodu aşağıdaki gibi değiştirerek deneyin.

VBA: 
Sub Değeleri_Yapıştır()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Sheets("SONUÇ").Unprotect
    Sheets("SONUÇ").Range("C100:AM159").Copy
    Sheets("SONUÇ").Range("C7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=True, Transpose:=False  'True kısmı boşlukları atla demek.
    Sheets("SONUÇ").Range("AT100:AX159").Copy
    Sheets("SONUÇ").Range("AT7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=True, Transpose:=False  'True kısmı boşlukları atla demek.
        For Each XD In Range("C7:AM66, AT7:AX66")
            If XD.Value = "" Then XD.ClearContents
        Next
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Sheets("SONUÇ").Select: Range("E7").Activate
    ActiveSheet.Protect
End Sub
 
Oyla 0 Olumsuz oyla
Hatta kod kısaltması isterseniz; kırmızı kısımların yerine yeşil olanlar kullanılabilir.

VBA: 
..................
Sheets("SONUÇ").Range("C7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=True, Transpose:=False
Sheets("SONUÇ").Range("C7").PasteSpecial xlPasteValues, , 1
..........................
Sheets("SONUÇ").Range("AT7").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                SkipBlanks:=True, Transpose:=False
Sheets("SONUÇ").Range("AT7").PasteSpecial xlPasteValues, , 1
.......................
 
Oyla 0 Olumsuz oyla
Teşekkür ederim kod için.
Gönderdiğiniz kod eklediğim dosyada çalıştı, işlemi yaptı. Fakat 12-13 saniye kadar sürüyor. Bu normal mi? Bu kadar uzun sürerse kullanamayacağım.
İkinci durum aynı yapıdaki diğer bir belgede For Each XD In XD için değişken atanmamış hatası veriyor.
 
Oyla 0 Olumsuz oyla
O zaman belgenizde Option Explicit satırı vardır.
Kodun ilk satırı olarak Dim XD As Range diye bir satır ekleyin.

Süre garip, gerçek belgenizi görseydik, duruma bakabilirdik.

.
 
Oyla 0 Olumsuz oyla
Ömer Bey,
Dosyamdaki düşeyara formülü işlemi uzatıyor. Dünkü dosyaya bu durumu öngörmediğim için bir formül yazıp geçmiştim.

Eklediğim belgede butona tıklayınca işlemin uzun sürdüğünü göreceksiniz. İşlem süresi asıl dosyamda daha uzun sürüyor.
Düşeyarayı kullanmak zorundayım.

KODDAKİ
Kod: 
        For Each XD In Range("C7:AM66, AT7:AX66")
            If XD.Value = "" Then XD.ClearContents
        Next
kısmı tam olarak nasıl işlem yapıyor bilmemekle beraber acaba hücreleri tek tek bulup silip mi diğer hücreye geçiyor diye düşünüyorum.
Eğer böyle ise işlemi kısaltmak için şöyle bir şey yapılabilir mi?

Makro yukarıdaki kod olmadan kopyalamayı yapsın sonra
Range("C7:AM66, AT7:AX66") bölgesindeki boş hücreler(bir şey yazmayan) topluca seçilsin ve ClearContents yapılsın.
 

Ekli dosyalar

Oyla 0 Olumsuz oyla
Bir de şöyle deneyin.

Copy yerine ilgili alandaki her hücre için;
-- hücre doluysa 93 satır üstündeki aynı sütun hücresine değeri yaz.
-- hücre boşsa (formül sonucu "" ise) 93 satır üstündeki hücre içeriğini temizle.

VBA: 
Sub Değeleri_Yapıştır()
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Sheets("SONUÇ").Unprotect
    
    For Each hcr In Sheets("SONUÇ").Range("C100:AM159, AT100:AX159")
        If hcr.Value <> "" Then hcr.Offset(-93, 0).Value = hcr.Value
        If hcr.Value = "" Then hcr.Offset(-93, 0).ClearContents
    Next
        
    Sheets("SONUÇ").Select: Range("E7").Activate
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    ActiveSheet.Protect
    
End Sub
 
Oyla 0 Olumsuz oyla
Çözüm
Sayın Baran,
Son kodu değil de son koddaki
Application.Calculation = xlCalculationManual
ve
Application.Calculation = xlCalculationAutomatic
satırlarını önceki koda uyguladığımda sorun çözülmüş oldu.

Yardımlarınız için teşekkür ederim. Sağ olun.
 
Oyla 0 Olumsuz oyla
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Benzer Konular Popüler İçerikler Daha Fazlası
Geri
Üst Alt