• DİKKAT

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

Makroyla satır ve birleştirilmiş sütunlar nasıl silinir?

A

assenucler

Altın Üye
Katılım
19 Ağustos 2004
Mesajlar
3,588
Excel Vers. ve Dili
Ofis 365 TR 64 Windows 11 Pro x64 TR
Değerli Dostlar;


Apartman yönetimimiz hesapları, profesyonel bir yazılımla tutmaktadır.

Yazılımın banka hesapları menüsünden "excele aktar"ile aldığımız raporda, her günün bitiminde "Gün toplamı" satırı ve ayrıca "birleştirilmiş sütunlar" bulunmaktadır.

1000-2000 satırlık banka kayıtları içeren excel raporu ile banka hesap ekstresinin kontrolünü daha güç yapmaktayız.

Word dosyasındaki resimde açıklandığı gibi, makro ile satırların ve birleştirilmiş sütunların silinmesi için yardımınızı bekliyorum.

Sevgi ve saygılar.
 

Ekli dosyalar

Aşağıdaki kodu VBA da module yapıştırıp deneyiniz.

Kod: 
Sub menu()
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
     Call bos_satir_sil
     Call Bos_sutun_Sil
     Call noktavirgulduzelt
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

Sub noktavirgulduzelt()
  sonsatir = Cells(Rows.Count, "C").End(3).Row
  Range("H6:I" & sonsatir).Select
  son = Application.Calculation '-4105

  With Application
    .Calculation = xlManual '-4135
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  
  Dim cell As Range
  nokta = "."
  virgul = ","
  For Each cell In ActiveWindow.RangeSelection.Cells
    cell.Value = Trim(cell.Value)
    If Mid(Right(cell.Value, 3), 1, 1) = nokta Then
       yer = Mid(cell.Value, 1, Len(cell.Value) - 3)
       deg9 = Replace(yer, virgul, nokta) & virgul & Mid(Right(cell.Value, 3), 2, 3)
       cell.Value = Replace(deg9, nokta, "") * 1
    Else
       If IsNumeric(cell.Value) = True And cell.Value > 0 Then
          cell.Value = cell.Value * 1
          cell.NumberFormat = "#,##0.00"
       End If
    End If
  Next

  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = son
  End With

End Sub

Sub bos_satir_sil()
   sonsatir = Cells(Rows.Count, "C").End(3).Row + 1
   For i = sonsatir To 5 Step -1
     veri = Cells(i, "C").Value
     If veri = "" Then
        Rows(i).Delete
     End If
   Next i
End Sub

Sub Bos_sutun_Sil()
    Columns("C:O").Select
    Selection.UnMerge
    Columns("O:O").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
    Columns("K:K").Select
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("F8").Select
End Sub
 
Son düzenleme:
Sayın asri;


Değerli üstadım, kısa süredeki güzel yanıtınız için çok teşekkür ederim. Sağ olun, var olun.

Düşündüğümden çok daha güzel bir çözüm öneriniz için teşekkürler.

Sayın asri, tablodaki "Tahsilat" ve "Ödeme" sütunlarını formülle toplamlarını alamıyorum. Hücre Biçimlendirme'ye baktığımda, "Genel" biçimi gözüküyor.

Acaba, mevcut kodlara "Tahsilat" ve "Ödeme" sütunlarının toplamına verecek ekleme yapılabilir mi? Ya da başka bir çözüm öneriniz olabilir mi?

En içten sevgi ve saygılarımla,
 
assenucler' Alıntı:
Sayın asri;


Değerli üstadım, kısa süredeki güzel yanıtınız için çok teşekkür ederim. Sağ olun, var olun.

Düşündüğümden çok daha güzel bir çözüm öneriniz için teşekkürler.

Sayın asri, tablodaki "Tahsilat" ve "Ödeme" sütunlarını formülle toplamlarını alamıyorum. Hücre Biçimlendirme'ye baktığımda, "Genel" biçimi gözüküyor.

Acaba, mevcut kodlara "Tahsilat" ve "Ödeme" sütunlarının toplamına verecek ekleme yapılabilir mi? Ya da başka bir çözüm öneriniz olabilir mi?

En içten sevgi ve saygılarımla,
Genişletmek için tıkla ...

Kod güncellendi. Kontrol ediniz.
 
Teşekkürler

Sayın asri,



Süper oldu.

Allah sizden razı olsun.

Sevgi ve saygılar.
 
Koda nasıl bir ekleme yapmak gerekiyor?

Değerli Dostlar;


Ekli dosyamdaki kodlar, Sayın asri üstadıma aittir.


Listede Tarih sütunu "C" sütunundan başladığında, mevcut kod sadece " "Tahsil Şekli" sütununu listelemiyor.

Kodlara nasıl bir ekleme yapmak gerekiyor?

İlgi ve yardımınız için teşekkürler.
 

Ekli dosyalar

assenucler' Alıntı:
Değerli Dostlar;
Ekli dosyamdaki kodlar, Sayın asri üstadıma aittir.
Listede Tarih sütunu "C" sütunundan başladığında, mevcut kod sadece " "Tahsil Şekli" sütununu listelemiyor.
Kodlara nasıl bir ekleme yapmak gerekiyor?
İlgi ve yardımınız için teşekkürler.
Genişletmek için tıkla ...

Aşağıdaki şekilde deneyiniz.

Kod: 
Sub menu()                                   'asri
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
     Call bos_satir_sil
     Call Bos_sutun_Sil
     Call noktavirgulduzelt
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
End Sub

Sub noktavirgulduzelt()
  sonsatir = Cells(Rows.Count, "C").End(3).Row
  Range("H6:I" & sonsatir).Select
  son = Application.Calculation '-4105

  With Application
    .Calculation = xlManual '-4135
    .ScreenUpdating = False
    .EnableEvents = False
  End With
  
  Dim cell As Range
  nokta = "."
  virgul = ","
  For Each cell In ActiveWindow.RangeSelection.Cells
    cell.Value = Trim(cell.Value)
    If Mid(Right(cell.Value, 3), 1, 1) = nokta Then
       yer = Mid(cell.Value, 1, Len(cell.Value) - 3)
       deg9 = Replace(yer, virgul, nokta) & virgul & Mid(Right(cell.Value, 3), 2, 3)
       cell.Value = Replace(deg9, nokta, "") * 1
    Else
       If IsNumeric(cell.Value) = True And cell.Value > 0 Then
          cell.Value = cell.Value * 1
          cell.NumberFormat = "#,##0.00"
       End If
    End If
  Next

  With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = son
  End With

End Sub

Sub bos_satir_sil()
   sonsatir = Cells(Rows.Count, "C").End(3).Row + 1
   For i = sonsatir To 5 Step -1
     veri = Cells(i, "C").Value
     If veri = "" Then
        Rows(i).Delete
     End If
   Next i
End Sub

Sub Bos_sutun_Sil()
    Columns("C:O").Select
    Selection.UnMerge
    Columns("O:O").Select
    Selection.Delete Shift:=xlToLeft
    Columns("M:M").Select
    Selection.Delete Shift:=xlToLeft
   [COLOR=Red] Columns("L:L").Select[/COLOR]
    Selection.Delete Shift:=xlToLeft
    Columns("I:I").Select
    Selection.Delete Shift:=xlToLeft
    Columns("F:F").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Cells.EntireColumn.AutoFit
    Range("F8").Select
End Sub
 
Teşekkür ve bir bilgi ricam

Sayın asri üstadım,


İlginiz ve kısa süredeki yanıtınız için teşekkürler.

Yukarıdaki kalıba benzer excel dosyalarını, sizin kodlardan yararlanarak kullanmaya çalışacağım.

Üstadım, son dosyadaki kodları; her ay aldığım listelerin "Modül" kısmına kopyala - yapıştır yaparak düğmeler aracılığıyla kullanıyorum.

Bu kopyala-yapıştır işlemini her ay yapmak zorunda mıyım? Daha pratik bir yolu var mı?

Sevgi ve saygılar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst