Mükerrer sil ve sırala

[Recep İpek]

Merhaba,

Ekteki örnekte göründüğü gibi tablodaki bir alanda bulunan örneğin

105:106:101:110:106:105

gibi : ile birleştirilmiş verilerden mükerrer olanları silip, sıralı olarak tekrar aynı alana yazırabilir miyiz?

Yani 101:105:106:110 şeklinde olacak.


....

 

[modalı]

Sayın Recep İpek,

Olayı tetikleyebilmek için bir form ve düğme ekledim. Siz tetiklemeyi istediğiniz noktada yapabilirsiniz.

Modüle 3 adet yordam ekledim, birincisi verileri bir dizine atıyor, ikincisi tekrarları silip sıralıyor, üçüncüsü ise kaydediyor.

Sonucu görebilmek için Tablonuzu DASTA1 olarak kopyaladım ve bu tablonun verilerini değiştirdim.

Siz kaydet yordamındaki DATA1 i DATA olarak değiştirin.

İyi çalışmalar

 

[Recep İpek]

Teşekkürler.

Tam istediğim şekilde çalışıyor.

Ben gece uzun uğraşlardan sonra aşağıdaki şekilde birşeyler yaptım.

DoCmd.RunSQL "UPDATE DATA SET DATA.alan1 = CustomGT([alan1],":")"

Option Compare Database
Const dictKey = 1
Const dictItem = 2
Function CustomGT(txt As String, Optional delim As String = " ") As String
Dim e
Dim veri
'**************************************************
Set d = CreateObject("Scripting.Dictionary")
With d
     .CompareMode = vbTextCompare
     For Each e In Split(txt, delim)
         veri = Trim(e) * 1
 
         If Trim(veri) <> "" And IsNumeric(veri) And Not .exists(veri) Then
            n = n + 1
            .Add veri, n
         End If
     Next
 
     SortDictionary d, dictKey, "ASC" 'dictItem
 
     If .Count > 0 Then CustomGT = Join(.Keys, delim)
 
End With
Set d = Nothing
End Function

Function SortDictionary(ByRef objDict, intSort, shorting)
  Dim strDict()
  Dim objKey
  Dim strKey, strItem
  Dim X, Y, Z
  Z = objDict.Count
  If Z > 1 Then
    ReDim strDict(Z, 2)
    X = 0
    For Each objKey In objDict
        strDict(X, dictKey) = CStr(objKey)
        strDict(X, dictItem) = CStr(objDict(objKey))
        X = X + 1
    Next
    For X = 0 To (Z - 2)
      For Y = X To (Z - 1)
        If shorting = "ASC" Then
            sh = CDbl(strDict(X, intSort)) > CDbl(strDict(Y, intSort))
        Else
            sh = CDbl(strDict(X, intSort)) < CDbl(strDict(Y, intSort))
        End If
        If sh Then
            strKey = strDict(X, dictKey)
            strItem = strDict(X, dictItem)
            strDict(X, dictKey) = strDict(Y, dictKey)
            strDict(X, dictItem) = strDict(Y, dictItem)
            strDict(Y, dictKey) = strKey
            strDict(Y, dictItem) = strItem
        End If
      Next
    Next
    objDict.RemoveAll
    For X = 0 To (Z - 1)
      objDict.Add strDict(X, dictKey), strDict(X, dictItem)
    Next
  End If
End Function

 

[Ergün Güler]

Selam,

Sayın Modalı ve Sayın Recep İpek,

Aynı soruyu Excel için sormuş olsak nasıl yapabiliriz? Yani 105:106:101:110:106:105 A sütununda olsa tekrarsız ve sıralı şekilde B sütununa yazmak istesek nasıl yapabiliriz?

İyi çalışmalar.