Aynı Değerlere Sahip Yan Yana sütunları Makro ile Silme

[yasin85]

Merhaba Değerli Arkadaşlar,

Öncelikle şunu bilmenizi isterim istediğim konu başlığı ile ilgili dünden beri arıyorum bulamıyorum..

7000 kalemlik veri tablom var sadeleştirme yapmam gerekli buna istinaden makro kodlarınızı bekliyor olacağım..

Detaylar şu şekildedir..
• 7000 hücre alt alta mevcut bunları hücre verilerini kendi içinde ‘’@’’ ayıra biliriz yan sütunlara metin bicimi olarak ayırması gerekli.
( Bu işlemi Metin Sütunlara dönüştür sihirbazından da oluyor fakat bicim kısmı tüm satırlarda metin olarak toplu olmuyor)

• Sonrasında Yan Yana sütunlarda aynı değerlere sahip verilerin 2 ve fazla olan hücrelerde 1 tanesini bırakıp diğerlerini hücre sil ile sol tarafa kaydırmak istiyorum birde boş olan satırları da gene aynı şekilde sil ile hücreyi sola kaydır işlemi yapmak istiyorum.

Sil yapmamın amacı gereksiz fazla veri yan yana olması bir yararı yok tekrar hepsini manüel silmem gerekecek bu sebeptendir.

Aşağıya 2 adet örnek hücre içinde bulunan verilerim şu şekildedir buradan kopyalıyıp bir hücre içine bu alanı eklerseniz daha net sorunu görmüş olacaksınız.

1-)

V411644V411644MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN14.170@16.168@16.240 FR@16.240@19.262@22.192@22.281@22.361@23.342@24.242@24.362@25.272@25.302@26.240@26.281@26.292@32.322@33.272@33.302@33.422ŞEMMONTAJ SİSTEM@ MOUNTING SYSTEM@ MOUNTING SYSTEM7827BUGİ BURCU (TAMİR TAKIMI)@BALL JOINT (REPAIR KIT)@САЙЛЕНБЛОК (Р/К)81.95301.6132@@V411644V411644MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN14170@16168@16240FR@16240@19262@22192@22281@22361@23342@24242@24362@25272@25302@26240@26281@26292@32322@33272@33302@33422SEMMONTAJSISTEM@MOUNTINGSYSTEM@MOUNTINGSYSTEM7827BUGIBURCUTAMIRTAKIMI@BALLJOINTREPAIRKIT@САЙЛЕНБЛОКРК81953016132@@


2-)

V273780V273780MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MANF 2000 19.273@F 2000 19.293@F 2000 19.314@F 2000 19.323@F 2000 19.343@F 2000 19.373@F 2000 19.403@F 2000 19.414@F 2000 19.423@F 2000 19.464@F 2000 23.403@F 2000 24.403@F 2000 26.273@F 2000 26.323@F 2000 26.423@F 2000 26.463@F 2000 26.603@F 2000 27.273@F 2ŞEMMONTAJ SİSTEM@ MOUNTING SYSTEM@ MOUNTING SYSTEM7780KABIN TAMIR TAKIMI (ALTERNATIF BLY)@REP.KIT FOR CABIN(ALT.BEARING)@Р/К КАБИНЫ@@V273780V273780MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MAN@MANF200019273@F200019293@F200019314@F200019323@F200019343@F200019373@F200019403@F200019414@F200019423@F200019464@F200023403@F200024403@F200026273@F200026323@F200026423@F200026463@F200026603@F200027273@F2SEMMONTAJSISTEM@MOUNTINGSYSTEM@MOUNTINGSYSTEM7780KABINTAMIRTAKIMIALTERNATIFBLY@REPKITFORCABINALTBEARING@РККАБИНЫ@@@@

 

[yasin85]

Zor bir talebim oldu sanırım..

 

[Erdem Akdemir]

Örnek dosya ekleyebilir misiniz?

Sorunuzu okumak bile zor.

 

[alicimri]

Sayın yasin85 Aşağıdaki Makroyu deneyin.

Sub Makro5()
Range("B1:CK" & Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "@"
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
dizi = Split(Range("a" & i).Value, "@")
q = 2
For e = 0 To UBound(dizi)
If Trim(CStr(dizi(e))) <> Cells(i, q - 1) And dizi(e) <> "" Then
Cells(i, q).Value = Trim(CStr(dizi(e)))
q = q + 1
End If
Next
Next
End Sub

M AN, MOU NTINGSYSTEM gibi hatalı olduğunu düşündüğüm verilerinde düzelmesini istiyorsanız alttaki kodları kullanın.

Sub Makro5()
Range("B1:CK" & Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "@"
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
dizi = Split(Range("a" & i).Value, "@")
q = 2
For e = 0 To UBound(dizi)
If Replace(Trim(CStr(dizi(e))), " ", "") <> Cells(i, q - 1) And dizi(e) <> "" Then
Cells(i, q).Value = Replace(Trim(CStr(dizi(e))), " ", "")
q = q + 1
End If
Next
Next
End Sub

 

[yasin85]

Sayın yasin85 Aşağıdaki Makroyu deneyin.

Sub Makro5()
Range("B1:CK" & Range("A" & Rows.Count).End(xlUp).Row).NumberFormat = "@"
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
dizi = Split(Range("a" & i).Value, "@")
q = 2
For e = 0 To UBound(dizi)
If Trim(CStr(dizi(e))) <> Cells(i, q - 1) And dizi(e) <> "" Then
Cells(i, q).Value = Trim(CStr(dizi(e)))
q = q + 1
End If
Next
Next
End Sub

Sn. AliCimri çok ama çok teşekkürler beni ne büyük işten kurtardın bir bilsen bu yazım az kalır bu yardımının karşılığında kucak dolusu sevgiler saygılar..