Aynı Sayfada Artı ve Eksi Sütunları Ayırma

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

FIlose

Kullanıcı
Excel Versiyonu
Excel 2021
Excel Sürümü
64 Bit
Excel Dili
Türkçe
Herkese merhaba,
Aynı sayfada bulunan banka ekstresi dosyasında ARTI ve EKSİ değer veren hücreleri makro ile ayrıştırmak istiyorum.
Ekli dosyada örnek vardır. Şöyle ki;

ARTI SÜTUNLARI
B Sütunu ==> I Sütununa
C Sütunu ==> J Sütununa
D Sütunu ==> K Sütununa

EKSİ SÜTUNLARI
B Sütunu ==> O Sütununa
C Sütunu ==> P Sütununa
D Sütunu ==> Q Sütununa

* Tarih sırasına göre sıralanacak.
Kısaca artı sütunlar ve eksi sütunlar kendi aralarında ayrılıp tarih sırasına konulacak.

Yardımcı olabilecek arkadaşlara şimdiden teşekkür ediyorum.
 
Benzer Verileri Makro ile Toplama
Listview Listesinden Seçilen Sayfayı Yazdırma
Listview Listesinden Seçilen Sayfayı Yazdırma

Ekli dosyalar

Tarihe göre sırala Oylamaya göre sırala
@FIlose

Şu kod işinizi görür.

VBA: 
Sub ARTI_EKSI_AYIR()
Range("I2:K" & Rows.Count).ClearContents
Range("O2:Q" & Rows.Count).ClearContents
ReDim arti(1 To 3, 1 To 1): ReDim eksi(1 To 3, 1 To 1)
v = Range("B2:D" & Cells(Rows.Count, 2).End(3).Row).Value
For XD = 1 To UBound(v)
    If v(XD, 3) > 0 Then
        a = a + 1: ReDim Preserve arti(1 To 3, 1 To a)
        arti(1, a) = 1 * CDate(v(XD, 1)): arti(2, a) = v(XD, 2): arti(3, a) = v(XD, 3)
    ElseIf v(XD, 3) < 0 Then
        e = e + 1: ReDim Preserve eksi(1 To 3, 1 To e)
        eksi(1, e) = 1 * CDate(v(XD, 1)): eksi(2, e) = v(XD, 2): eksi(3, e) = v(XD, 3)
    End If
Next: Columns("I:Q").WrapText = True
[I2].Resize(a, 3) = Application.Transpose(arti)
[O2].Resize(e, 3) = Application.Transpose(eksi)
Columns(9).NumberFormat = "dd.mm.yyyy": Columns(15).NumberFormat = "dd.mm.yyyy"
Range("I2:K" & a + 1).Sort [I1], 1: Range("O2:Q" & e + 1).Sort [O1], 1
End Sub
 
Oyla 0 Olumsuz oyla
Çözüm
Ömer BARAN' Alıntı:
@FIlose

Şu kod işinizi görür.

VBA: 
Sub ARTI_EKSI_AYIR()
Range("I2:K" & Rows.Count).ClearContents
Range("O2:Q" & Rows.Count).ClearContents
ReDim arti(1 To 3, 1 To 1): ReDim eksi(1 To 3, 1 To 1)
v = Range("B2:D" & Cells(Rows.Count, 2).End(3).Row).Value
For XD = 1 To UBound(v)
    If v(XD, 3) > 0 Then
        a = a + 1: ReDim Preserve arti(1 To 3, 1 To a)
        arti(1, a) = 1 * CDate(v(XD, 1)): arti(2, a) = v(XD, 2): arti(3, a) = v(XD, 3)
    ElseIf v(XD, 3) < 0 Then
        e = e + 1: ReDim Preserve eksi(1 To 3, 1 To e)
        eksi(1, e) = 1 * CDate(v(XD, 1)): eksi(2, e) = v(XD, 2): eksi(3, e) = v(XD, 3)
    End If
Next: Columns("I:Q").WrapText = True
[I2].Resize(a, 3) = Application.Transpose(arti)
[O2].Resize(e, 3) = Application.Transpose(eksi)
Columns(9).NumberFormat = "dd.mm.yyyy": Columns(15).NumberFormat = "dd.mm.yyyy"
Range("I2:K" & a + 1).Sort [I1], 1: Range("O2:Q" & e + 1).Sort [O1], 1
End Sub
Genişletmek için tıklayın ...
Ömer Bey çok teşekkür ediyorum. Sorun gözükmüyor.
Elleriniz dert görmesin.

Sağlık ve minnetle
 
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