Veri Saydırma Hk.

[metin_0606]

Değerli üstatlar H sütununda yazılı olan şehir isimlerini tablonun Q ve R sütunlarına saydırmak istiyorum. Örnek çalışma ektedir. Yardımlarınız için şimdiden teşekkürler.
Not: Örnek Olarak
Q SÜTUNU R SÜTUNU
İSTANBUL 25
ANKARA 36

 

[1Al2Ver]

Merhaba,

Yanlış anlamadım ise, örnek çözüm ;

"Q" sütununa illeri alfabetik ekledim, "R" sütununa EĞERSAY formülü uyguladım,

Kolay gelsin.

 

[metin_0606]

Merhaba,

Yanlış anlamadım ise, örnek çözüm ;

"Q" sütununa illeri alfabetik ekledim, "R" sütununa EĞERSAY formülü uyguladım,

Kolay gelsin.

Teşekkürler hocam emeğinize sağlık formül olayı benim uygulamalarımı çok yavaşlatmakta, o yüzden makrolu çözüm olursa benim için daya iyi olur

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Say()
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim S1 As Worksheet, Dizi As Object, Zaman As Double
    
    Zaman = Timer

    Set Dizi = CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("PERSONEL NUFUS BILGILERI")

    Son = S1.ListObjects("Tablo13").Range.Columns(8).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Veri = S1.Range("H3:H" & Son).Value
    
    ReDim Liste(1 To UBound(Veri), 1 To 2)
    
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            If Not Dizi.Exists(Veri(X, 1)) Then
                Say = Say + 1
                Dizi.Add Veri(X, 1), Say
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = 1
            Else
                Liste(Dizi.Item(Veri(X, 1)), 2) = Liste(Dizi.Item(Veri(X, 1)), 2) + 1
            End If
        End If
    Next

    S1.Range("Q3:R" & S1.Rows.Count).ClearContents
    S1.Range("Q3").Resize(Dizi.Count, 2) = Liste
    S1.Range("Q3").Resize(Dizi.Count, 2).Sort S1.Range("Q3"), xlAscending, , , , , , xlYes
    
    Set Dizi = Nothing
    Set S1 = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

 

[metin_0606]

Deneyiniz.

Option Explicit

Sub Say()
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim S1 As Worksheet, Dizi As Object, Zaman As Double
   
    Zaman = Timer

    Set Dizi = CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("PERSONEL NUFUS BILGILERI")

    Son = S1.ListObjects("Tablo13").Range.Columns(8).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Veri = S1.Range("H3:H" & Son).Value
   
    ReDim Liste(1 To UBound(Veri), 1 To 2)
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            If Not Dizi.Exists(Veri(X, 1)) Then
                Say = Say + 1
                Dizi.Add Veri(X, 1), Say
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = 1
            Else
                Liste(Dizi.Item(Veri(X, 1)), 2) = Liste(Dizi.Item(Veri(X, 1)), 2) + 1
            End If
        End If
    Next

    S1.Range("Q3:R" & S1.Rows.Count).ClearContents
    S1.Range("Q3").Resize(Dizi.Count, 2) = Liste
    S1.Range("Q3").Resize(Dizi.Count, 2).Sort S1.Range("Q3"), xlAscending, , , , , , xlYes
   
    Set Dizi = Nothing
    Set S1 = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Teşekkürler korhan hocam zihnine sağlık

 

[metin_0606]

Deneyiniz.

Option Explicit

Sub Say()
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim S1 As Worksheet, Dizi As Object, Zaman As Double
   
    Zaman = Timer

    Set Dizi = CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("PERSONEL NUFUS BILGILERI")

    Son = S1.ListObjects("Tablo13").Range.Columns(8).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Veri = S1.Range("H3:H" & Son).Value
   
    ReDim Liste(1 To UBound(Veri), 1 To 2)
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            If Not Dizi.Exists(Veri(X, 1)) Then
                Say = Say + 1
                Dizi.Add Veri(X, 1), Say
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = 1
            Else
                Liste(Dizi.Item(Veri(X, 1)), 2) = Liste(Dizi.Item(Veri(X, 1)), 2) + 1
            End If
        End If
    Next

    S1.Range("Q3:R" & S1.Rows.Count).ClearContents
    S1.Range("Q3").Resize(Dizi.Count, 2) = Liste
    S1.Range("Q3").Resize(Dizi.Count, 2).Sort S1.Range("Q3"), xlAscending, , , , , , xlYes
   
    Set Dizi = Nothing
    Set S1 = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Korhan hocam kendi veri yükü dosyama uyguladığımda tablodaki verileri sildi neden acaba

 

[Korhan Ayhan]

Silme işlemi sadece Q-R sütunlarında yapılıyor.

 

[metin_0606]

Deneyiniz.

Option Explicit

Sub Say()
    Dim Son As Long, Veri As Variant, X As Long, Say As Long
    Dim S1 As Worksheet, Dizi As Object, Zaman As Double
   
    Zaman = Timer

    Set Dizi = CreateObject("Scripting.Dictionary")
    Set S1 = Sheets("PERSONEL NUFUS BILGILERI")

    Son = S1.ListObjects("Tablo13").Range.Columns(8).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Veri = S1.Range("H3:H" & Son).Value
   
    ReDim Liste(1 To UBound(Veri), 1 To 2)
   
    For X = LBound(Veri) To UBound(Veri)
        If Veri(X, 1) <> "" Then
            If Not Dizi.Exists(Veri(X, 1)) Then
                Say = Say + 1
                Dizi.Add Veri(X, 1), Say
                Liste(Say, 1) = Veri(X, 1)
                Liste(Say, 2) = 1
            Else
                Liste(Dizi.Item(Veri(X, 1)), 2) = Liste(Dizi.Item(Veri(X, 1)), 2) + 1
            End If
        End If
    Next

    S1.Range("Q3:R" & S1.Rows.Count).ClearContents
    S1.Range("Q3").Resize(Dizi.Count, 2) = Liste
    S1.Range("Q3").Resize(Dizi.Count, 2).Sort S1.Range("Q3"), xlAscending, , , , , , xlYes
   
    Set Dizi = Nothing
    Set S1 = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır." & vbLf & vbLf & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Korhan hocam makro görevini yapıyor ancak bu makroyu çalıştırdıktan sonra gizli sayfalardan verileri çektiğim bütün makrolarda bu hatayı veriyor.

 

[Korhan Ayhan]

Kodlarınıza Dim Say As Long ekleyip deneyin.

 

[metin_0606]

Kodlarınıza Dim Say As Long ekleyip deneyin.

Şimdi düzeldi hocam çok teşekkür ederim