• DİKKAT

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

Hücredeki değerleri alfabetik sıralama

  • Konbuyu başlatan Konbuyu başlatan uuthbey
  • Başlangıç tarihi Başlangıç tarihi
Katılım
7 Ağustos 2010
Mesajlar
14
Excel Vers. ve Dili
vbasic
Selamlar,
elimde yoğun bir data var. Bu datayı sadeleştirerek kontrol edilmesi daha kolay bir hale getirmeye çalışıyorum. Satırlar aşağıdaki şekilde oluşuyor:

SİVAS/ TOKAT/ YOZGAT/ ERBAA
SİVAS/ TOKAT/ YOZGAT/ SİVAS/ ERBAA
SİVAS/ TOKAT/ YOZGAT/ SİVAS/ ERBAA

Bunların her biri bir satırda yer alıyor. Gördüğünüz gibi değer iki veya üç kere yazılmış olabiliyor. Yapmaya çalıştığım şey şu: bir hücredeki değerlerin tekrar edenlerini kaldırmak ve hücredeki bu değerleri aşağıdaki şekilde alfabetik sıralamak:

ERBAA / SİVAS / TOKAT / YOZGAT
ERBAA / SİVAS / TOKAT / YOZGAT
ERBAA / SİVAS / TOKAT / YOZGAT

Şimdiden yardımlarınız için teşekkür ediyorum.
 
Son düzenleme:
Sub BenzerSil()
For i = [A65536].End(3).Row To 2 Step -1
If Cells(i, "A") = Cells(i - 1, "A") Then Rows(i).Delete
Next i
End Sub


Necdet Yeşertener'den alıntıdır.
 
vermiş olduğunuz kod, sütun boyunca aynı içeriğe sahip satırları siliyor. bir nevi "yinelenenleri kaldır".
ben değişiklik sadece hücre içerisinde olsun istiyorum.
 
Biraz karışık oldu ama idare edin artık.
Bu kadar yapabildim :)

A1'den itibaren A sütunundaki verilerin tekrarlılarını siler ve yine A sütununa alfabetik olarak sıralar.

Kod:
Sub duzenle()
ayrac = "/ "
For j = 1 To [A65500].End(3).Row
k = Len(Cells(j, 1)) - Len(WorksheetFunction.Substitute(Cells(j, 1), "/", "")) + 1
    For i = 1 To k
    On Error Resume Next
    Cells(j, i + 20) = Split(Cells(j, 1), ayrac)(i - 1)
        For m = 21 To i + 20
        If Cells(j, i + 20) = Cells(j, m) Then say = say + 1
        Next m
        If say > 1 Then Cells(j, i + 20) = ""
        say = 0
    Next i
Range("U" & j & ":BA" & j).Sort Key1:=Range("U" & j), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, DataOption1:=xlSortNormal
    For Z = 21 To 30
        If Cells(j, Z) = "" Then
        ElseIf yaz = "" Then
        yaz = Cells(j, Z)
        Else: yaz = yaz & ayrac & Cells(j, Z)
        End If
    Next Z
Cells(j, 1) = yaz
yaz = ""
Next j
Columns("U:BA").ClearContents
End Sub
 
çok ama çok teşekkür ederim üstad. emeğinize aklınıza sağlık. tam işime yarayacak şekilde olmuş.
 
Rica ederim, iyi çalışmalar...
 
A ve B sütunu veya farklı sütunlar için de aynı işlemi yapmak için kod'da nerede değişiklik yapmamız gerekiyor.
 
Geri
Üst