Soru D-E-F Sütünlerindaki Fazlalıkları Silmek

[bulentkars]

Arkadaşlar Merhaba,

Ekteki tabloda detaylıca anlattım, yardımcı olabilirseniz çok sevinirim. Şİmdiden Teşekkürle

1- D Kolonunda 0- olanlar silinecek.
2 -D Kolonunda Kırmızıya boyadığım hicrelerde 0- silindikten sonra başta virgül olanların yanına "0" sıfır koyacak. Örneğin D2 = 0,25-2,1 olacak.
3 - E Kolununda 0-0- olanlar silincek sutunlarda sadece günler kalacak örneğin E18 = 61 olacak
4 - F Kolonunda Alt Limiti 1 adet olanlar duracak.örneğin F22,F23 işlem yapılamayacak.
5 - F Kolonunda Alt limiti 2 olanlarda eğer iki tutar da aynı ise birini silecek. Örneğin F18 satırı 85.000 olacak, diğer - ve sonrası silinecek.
6 - F Kolonunda Alt Limiti 3 olanlarda aynı olanları silecek. Farkklı olanlar kalacak. Örneğin F2 satırında 300.000 iki adet olduğundan biri silinecek ve sonuç 80000-300000 kalacak.

 

[ÖmerBey]

Merhaba,
Deneyiniz...

Sub kod()
Dim x As Byte
Dim a As Long, son As Long
Dim veri As Variant, v As Variant, dz As Variant, yeni As Variant
Dim alan As Range
Dim s As Object

Set s = CreateObject("Scripting.Dictionary")
son = Cells(Rows.Count, 1).End(3).Row
Set alan = Range("A1:F" & son)
dz = alan.Value
For a = 2 To UBound(dz)
    ReDim yeni(0)
    x = 0
    veri = Split(dz(a, 4), "-")
    For Each v In veri
        If v <> 0 Then
            ReDim Preserve yeni(x)
            yeni(x) = IIf(Left(v, 1) = ",", 0, "") & v
            x = x + 1
        End If
    Next
    dz(a, 4) = Join(yeni, "-")
    
    ReDim yeni(0)
    x = 0
    veri = Split(dz(a, 5), "-")
    For Each v In veri
        If v <> 0 Then
            ReDim Preserve yeni(x)
            yeni(x) = v
            x = x + 1
        End If
    Next
    dz(a, 5) = Join(yeni, "-")
    
    s.RemoveAll
    veri = Split(dz(a, 6), "-")
    For Each v In veri
        If Not s.Exists(v) Then
            s.Add v, ""
        End If
    Next
    dz(a, 6) = Join(s.Keys(), "-")
Next
alan.Value = dz
End Sub

 

[bulentkars]

Ömer Bey,

Yine yetiştiniz allah sizden razı olsun. Çok çok teşekkür ederim. Bu işlemi yapmak mümkün olur mu acaba? olmuyorsa da bu işimi görür..

en son işlem bittikten sonra
F sutunundaki "40000-800000" bu şekilde olan sonuçları
"40.000-800.000" Tutar olarak nokta koya bilirmiyiz acaba yeni aklıma geldi, Teşekkürler

 

[ÖmerBey]

Son döngüyü aşağıdaki şekilde değiştiriniz ve F sütununu da metin olarak biçimlendirip deneyiniz.

    For Each v In veri
        If Not s.Exists(Format(v, "#,##0")) Then
            s.Add Format(v, "#,##0"), ""
        End If
    Next

 

[bulentkars]

Ömer Bey,

Emeğinize sağlık çok teşekkür ediyorum. Allah razı olsun

 

[ÖmerBey]

Rica ederim, Allah hepimizden razı olsun.
İyi çalışmalar...