Spreadsheet1 nesnesinde Sıralama

hsayar · 27 Ocak 2008

Spreadsheet1 nesnesinde Sıralama nasıl olmalıdır.
6 sütunu başlık satırı var şeklinde büyükten küçüğe doğru nasıl sıralarım.

Levent Menteşoğlu · 27 Ocak 2008

Bir excel sayfasındaki sıralama mantığına benzer bir mantık kullanabilirsiniz.

hsayar · 27 Ocak 2008

hocam o şekilde denedim olmuyor

Kod:

Private Sub ComboBox85_Change()
If ComboBox85.Value = "" Then Exit Sub
'On Error Resume Next
Call DegiskenTani
Dim i As Integer, SQLStr As String
Spreadsheet1.Rows("2:" & [a65536].End(3).Row).Interior.ColorIndex = xlNone
Spreadsheet1.Rows("2:" & [a65536].End(3).Row).Font.Bold = False
Spreadsheet1.Rows("2:" & [a65536].End(3).Row).Font.ColorIndex = 0
'If ComboBox85.Value = "" Then Exit Sub
'Spreadsheet1.Range("a1:f100").ClearContents

Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset
    basliklar = "TCK_NO, ADI, SOYADI,ILKSOYADI, BABAADI, ANNEADI" '& ","
    basliklar = basliklar & "," & "DOGUM_Y, DOGUM_T, MD_HAL, CNS"
'    basliklar = basliklar & "SIG_NO"
    sayfaadi = "[DATA$]"
    sorgu = "TCK_NO = " & ComboBox85.Value
        SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu
    With RecTcNo
            .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
            .MoveFirst
            ComboBox86.Value = .Fields("ADI")
            TextBox3.Value = .Fields("SOYADI")
            TextBox15.Value = .Fields("ILKSOYADI")
            TextBox4.Value = .Fields("BABAADI")
            TextBox5.Value = .Fields("ANNEADI")
            TextBox6.Value = .Fields("DOGUM_Y")
            TextBox7.Value = .Fields("DOGUM_T")
'            TextBox16.Value = .Fields("SIG_NO")
            If .Fields("CNS") = "Erkek" Then
                OptionButton1.Value = 1
            ElseIf .Fields("CNS") = "Kad&#305;n" Then
                OptionButton2.Value = 1
            Else
                OptionButton1.Value = 0: OptionButton2.Value = 0
            End If
    If CBool(.State And adStateOpen) = True Then .Close
    End With
Set RecTcNo = Nothing

Dim RecYkTcNo As ADODB.Recordset: Set RecYkTcNo = New ADODB.Recordset
    basliklar = "TCK_NO, AD_SOYAD, YK_DRC, YKN_TCK_NO, YKN_AD_SOYAD, YKN_CNS, YKN_DOGUM_Y, YKN_DOGUM_T"
    sayfaadi = "[DATA$]"
    sorgu = "TCK_NO = " & ComboBox85.Value
        SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu

    With RecYkTcNo
            .Open SQLStr, bagYKN, adOpenKeyset, adLockOptimistic
        If .RecordCount > 0 Then
            Spreadsheet1.Range("a1:f100").ClearContents
            Spreadsheet1.Cells(1, 1) = "YK_DRC"
            Spreadsheet1.Cells(1, 2) = "YKN_TCK_NO"
            Spreadsheet1.Cells(1, 3) = "YKN_AD_SOYAD"
            Spreadsheet1.Cells(1, 4) = "YKN_CNS"
            Spreadsheet1.Cells(1, 5) = "YKN_DOGUM_Y"
            Spreadsheet1.Cells(1, 6) = "YKN_DOGUM_T"
            Spreadsheet1.Columns(1).ColumnWidth = 6
            Spreadsheet1.Columns(2).ColumnWidth = 15
            Spreadsheet1.Columns(3).ColumnWidth = 20
            Spreadsheet1.Columns(4).ColumnWidth = 6
            Spreadsheet1.Columns(5).ColumnWidth = 20
            Spreadsheet1.Columns(6).ColumnWidth = 15
            sat = 1
            .MoveFirst
                For i = 1 To .RecordCount
                    Spreadsheet1.Cells(sat + i, 1).Value = .Fields("YK_DRC")
                    Spreadsheet1.Cells(sat + i, 2).Value = .Fields("YKN_TCK_NO")
                    Spreadsheet1.Cells(sat + i, 3).Value = .Fields("YKN_AD_SOYAD")
                    Spreadsheet1.Cells(sat + i, 4).Value = .Fields("YKN_CNS")
                    Spreadsheet1.Cells(sat + i, 5).Value = .Fields("YKN_DOGUM_Y")
                    Spreadsheet1.Cells(sat + i, 6).Value = Format(.Fields("YKN_DOGUM_T"), "dd.mm.yyyy")
                   .MoveNext
                Next i
            .MoveFirst
[color="red"]            Spreadsheet1.Range("A1:f100").Select
            Application.CutCopyMode = False
            Selection.Sort Key1:=Spreadsheet1.Range("F2"), Order1:=xlAscending, Header:=xlGuess, _
                            OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
                            DataOption1:=xlSortNormal [/color]
        End If
        If CBool(.State And adStateOpen) = True Then .Close
    End With
Set RecYTcNo = Nothing
End Sub

Zeki Gürsoy · 27 Ocak 2008

Ctrl + I ile argumanları inceleyin.

Kod:

Spreadsheet1.Range("a1:f10").Sort _
        6, xlAscending, xlGuess

hsayar · 27 Ocak 2008

hocam alakanıza teşekkür ederim ama olmadı.

hsayar · 27 Ocak 2008

örnek dosyayı ekledim hocam
Sorum
1) combobox 85 değiştikten sonra bağlı veriler yakınları veritabanından spreadsheet1 e geliyor... orada dağının girlmiş olabilir. bunun için doğum tarihine göre nasıl sıralanmalıdır.

2) ek olarak combobox85 (personel veritabanındaki kimlik noları gelir) te görüntünün tcno, ad, soyad şeklinde olması mümkün müdür?

ActiveX hatası çıkar ise
boş bir modülde

Kod:

Sub regolustur()
Dim deg As Object
anahtar = "HKCU\Software\Microsoft\VBA\Security\LoadControlsInForms"
Set deg = CreateObject("WScript.Shell")
deg.RegWrite anahtar, 1, "REG_DWORD"
End Sub

çalıştırın.

Alıntıdır. Sn Leventm
http://www.excel.web.tr/showthread.php?t=15136&highlight=spreadsheet+registry

Zeki Gürsoy · 28 Ocak 2008

Dosyanız SQL açma hatası veriyor. Sizin için farklı sütunlara göre sıralama örneği ekledim.

Kod:

Private Sub CommandButton1_Click()
Spreadsheet1.Columns("a:j").Sort 1, xlAscending, xlYes
End Sub
 
Private Sub CommandButton2_Click()
Spreadsheet1.Columns("a:j").Sort 8, xlAscending, xlYes
End Sub
 
Private Sub CommandButton3_Click()
Spreadsheet1.Columns("a:j").Sort 7, xlAscending, xlYes
End Sub

hsayar · 28 Ocak 2008

hocam alakanıza teşekkür ederim sorun şurada zannedersem

Kod:

Private Sub ComboBox85_Change()
If ComboBox85.Value = "" Then Exit Sub
'On Error Resume Next
Call DegiskenTani
Dim i As Integer, SQLStr As String
With Spreadsheet1
        .Rows("2:100").Interior.ColorIndex = xlNone
        .Rows("2:100").Font.Bold = False
        .Rows("2:100").Font.ColorIndex = 0
End With
'If ComboBox85.Value = "" Then Exit Sub
'Spreadsheet1.Range("a1:f100").ClearContents

Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset
    basliklar = "TCK_NO, ADI, SOYADI,ILKSOYADI, BABAADI, ANNEADI" '& ","
    basliklar = basliklar & "," & "DOGUM_Y, DOGUM_T, MD_HAL, CNS"
'    basliklar = basliklar & "SIG_NO"
    sayfaadi = "[DATA$]"
    sorgu = "TCK_NO = " & ComboBox85.Value
        SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu
    With RecTcNo
        .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
        If .RecordCount = 0 Then
            Spreadsheet1.Range("a1:f100").ClearContents
            Dim ctrl As Control
                For Each ctrl In Me.Frame1.Controls
                    If TypeName(ctrl) = "TextBox" Then
                        ctrl.BackColor = &H80000011
                        ctrl = Empty
                    End If
                Next
                Exit Sub
        ElseIf .RecordCount > 0 Then
                For Each ctrl In Me.Frame1.Controls
                    If TypeName(ctrl) = "TextBox" Then
                        ctrl.BackColor = &H80000002
                    End If
                Next
            .MoveFirst
            TextBox25.Value = .Fields("ADI")
            TextBox3.Value = .Fields("SOYADI")
            TextBox15.Value = .Fields("ILKSOYADI")
            TextBox4.Value = .Fields("BABAADI")
            TextBox5.Value = .Fields("ANNEADI")
            TextBox6.Value = .Fields("DOGUM_Y")
            TextBox7.Value = .Fields("DOGUM_T")
'            TextBox16.Value = .Fields("SIG_NO")
            If .Fields("CNS") = "Erkek" Then
                OptionButton1.Value = 1
            ElseIf .Fields("CNS") = "Kad&#305;n" Then
                OptionButton2.Value = 1
            Else
                OptionButton1.Value = 0: OptionButton2.Value = 0
            End If
        End If
    If CBool(.State And adStateOpen) = True Then .Close
    End With
Set RecTcNo = Nothing

Dim RecYkTcNo As ADODB.Recordset: Set RecYkTcNo = New ADODB.Recordset
    basliklar = "TCK_NO, AD_SOYAD, YK_DRC, YKN_TCK_NO, YKN_AD_SOYAD, YKN_CNS, YKN_DOGUM_Y, YKN_DOGUM_T"
    sayfaadi = "[DATA$]"
    sorgu = "TCK_NO = " & ComboBox85.Value
        SQLStr = "SELECT " & basliklar & " FROM " & sayfaadi & " WHERE " & sorgu

    With RecYkTcNo
            Spreadsheet1.Range("a1:f100").ClearContents
            .Open SQLStr, bagYKN, adOpenKeyset, adLockOptimistic
        If .RecordCount = 0 Then
            Exit Sub
        ElseIf .RecordCount > 0 Then
            Spreadsheet1.Cells(1, 1) = "YK_DRC"
            Spreadsheet1.Cells(1, 2) = "YKN_TCK_NO"
            Spreadsheet1.Cells(1, 3) = "YKN_AD_SOYAD"
            Spreadsheet1.Cells(1, 4) = "YKN_CNS"
            Spreadsheet1.Cells(1, 5) = "YKN_DOGUM_Y"
            Spreadsheet1.Cells(1, 6) = "YKN_DOGUM_T"
            Spreadsheet1.Columns(1).ColumnWidth = 6
            Spreadsheet1.Columns(2).ColumnWidth = 15
            Spreadsheet1.Columns(3).ColumnWidth = 20
            Spreadsheet1.Columns(4).ColumnWidth = 6
            Spreadsheet1.Columns(5).ColumnWidth = 20
            Spreadsheet1.Columns(6).ColumnWidth = 15
            
            sat = 1
            .MoveFirst
                For i = 1 To .RecordCount
                    Spreadsheet1.Cells(sat + i, 1).Value = .Fields("YK_DRC")
                    Spreadsheet1.Cells(sat + i, 2).Value = .Fields("YKN_TCK_NO")
                    Spreadsheet1.Cells(sat + i, 3).Value = .Fields("YKN_AD_SOYAD")
                    Spreadsheet1.Cells(sat + i, 4).Value = .Fields("YKN_CNS")
                    Spreadsheet1.Cells(sat + i, 5).Value = .Fields("YKN_DOGUM_Y")
                    Spreadsheet1.Cells(sat + i, 6).Value = Format(.Fields("YKN_DOGUM_T"), "dd.mm.yyyy")
                    'Spreadsheet1.Cells(sat + i, 6).Value = .Fields("YKN_DOGUM_T")
                   .MoveNext
                Next i
            .MoveFirst
            Spreadsheet1.Columns("A:F").Sort 6, xlAscending, xlYes
        End If
        If CBool(.State And adStateOpen) = True Then .Close
    End With
Set RecYTcNo = Nothing
End Sub

kodlarında
doğumtarihini aşağıdaki gibi alırsak sıralama yapmıyor
Spreadsheet1.Cells(sat + i, 6).Value = Format(.Fields("YKN_DOGUM_T"), "dd.mm.yyyy")

doğum tarihini aşağıdaki gibi alırsak sıralama yapıyor ama buda 38252 gibi rakamsal değeri benim işimi görmüyor

Spreadsheet1.Cells(sat + i, 6).Value = .Fields("YKN_DOGUM_T")

ne önerirsiniz
sıralama satırım

dosyanın açmamsına gelince bende sağlıklı bir şekilde açıyordu 4 tane veri tabanının 4 üde aynı klasör altında olmalı

[odbc] ile başlıyorsa valla sebebini bilmem

Zeki Gürsoy · 28 Ocak 2008

Listeleme yapılırken hücrebiçimini de verebilirsiniz.

Kod:

Spreadsheet1.Cells(sat + i, 6).Value = _
FormatDateTime(.Fields("YKN_DOGUM_T"), vbShortDate)

hsayar · 28 Ocak 2008

hocam 9. mesajda başarısız oldu ama ben başka bir yöntem buldum umarım daha pratiği vardır

Kod:

.......................
    With RecYkTcNo
 .......................
            sat = 1
            .MoveFirst
                For i = 1 To .RecordCount
                    Spreadsheet1.Cells(sat + i, 1).Value = .Fields("YK_DRC")
                    Spreadsheet1.Cells(sat + i, 2).Value = .Fields("YKN_TCK_NO")
                    Spreadsheet1.Cells(sat + i, 3).Value = .Fields("YKN_AD_SOYAD")
                    Spreadsheet1.Cells(sat + i, 4).Value = .Fields("YKN_CNS")
                    Spreadsheet1.Cells(sat + i, 5).Value = .Fields("YKN_DOGUM_Y")
                    'Spreadsheet1.Cells(sat + i, 6).Value = Format(.Fields("YKN_DOGUM_T"), "dd.mm.yyyy")
                    Spreadsheet1.Cells(sat + i, 6).Value = .Fields("YKN_DOGUM_T")
[B]do&#287;um tarihini veritaban&#305;ndan oldu&#287;u gibi al&#305;p[/B]
                   'Spreadsheet1.Cells(sat + i, 6).Value = FormatDateTime(.Fields("YKN_DOGUM_T"), vbShortDate)
                   .MoveNext
                Next i
            .MoveFirst
            Spreadsheet1.Columns("A:F").Sort 6, xlAscending, xlYes
[B]'6 c&#305; kolona g&#246;re s&#305;ralayorum[/B]
            For i = 2 To 100
                If Spreadsheet1.Cells(i, 6).Value <> "" Then
                    Spreadsheet1.Cells(i, 6).Value = Format(Spreadsheet1.Cells(i, 6).Value, "dd.mm.yyyy")
                End If
            Next i
[B]'daha sonra 6 kolonu gg.aa.yyyy format&#305;na &#231;eviriyorum[/B]
        End If
...................

Zeki Gürsoy · 28 Ocak 2008

Hata vermemesi gerekirdi. Biçimlendirmeyi ilk seferde de yapabilirsiniz.

Kod:

Spreadsheet1.Columns(6).NumberFormat = "dd/mm/yyyy"

hsayar · 28 Ocak 2008

teşekkürler hocasm bu daha güzel oldu

Kod:

[B]                    Spreadsheet1.Cells(sat + i, 6).Value = .Fields("YKN_DOGUM_T")[/B]                  
                        .MoveNext
                Next i
            .MoveFirst
            
[B]            Spreadsheet1.Columns("A:F").Sort 6, xlAscending, xlYes
            Spreadsheet1.Columns(6).NumberFormat = "dd/mm/yyyy"[/B]

hsayar · 28 Ocak 2008

sn anemos hocam 6. mesajdaki 2 sorum ile igili fikriniz nedir

combobox a 3 kolon atayıp
1 kolona > kapalı dosyadaki tcno,
2 kolona > kapalı dosyadaki ad,
3 kolona > soyad,

getirtilebilirmi

hsayar · 28 Ocak 2008

Kod:

.....................
'***************************
    SQLStr = "SELECT DISTINCT TCK_NO FROM [DATA$]"    'kynMHBRM dosyada ilgili sat&#305;rlarda sorgu yap
    Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset
    With RecTcNo
        .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
        .MoveFirst:        ComboBox85.Clear
            For i = 1 To .RecordCount
               ComboBox85.AddItem .Fields("TCK_NO")
               .MoveNext
            Next i
        .MoveFirst:        ComboBox85.ListIndex = 0
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    Set RecTcNo = Nothing
'___________________________
...................

çalışan kodlar bu ise

Kod:

.....................
'***************************
    SQLStr = "SELECT DISTINCT TCK_NO FROM [DATA$]"    'kynMHBRM dosyada ilgili sat&#305;rlarda sorgu yap
    Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset
    With RecTcNo
        .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
        .MoveFirst:        ComboBox85.Clear
            For i = 1 To .RecordCount
[color="red"]               
combobox 85, 3 kolonlu olsun 

ComboBox85.1kolonu.AddItem .Fields("TCK_NO")  
ComboBox85.2kolonu.AddItem .Fields("ad")  
ComboBox85.3kolonu.AddItem .Fields("soyad")  
olsun

[/color]

               .MoveNext
            Next i
        .MoveFirst:        ComboBox85.ListIndex = 0
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    Set RecTcNo = Nothing
'___________________________
...................

demek istiyorum

rowsource olayının kapalı dosya versiyonu ama nasıl

Zeki Gürsoy · 28 Ocak 2008

Combonun "Column" özelliğini 3 yaptıktan sonra aşağıdaki gibi eleman ekleyebilirsiniz.

Kod:

Combobox85.Additem
combobox85.List(0,0)=rs(..)
combobox85.List(0,1)=rs(..)
.
.

hsayar · 28 Ocak 2008

olmuyor hocam beceremiyorum invalid proporty diyor

Kod:

 With ComboBox85
     .ColumnCount = 3
     .ColumnWidths = "75;40;50"
     .ListRows = "10"
     '.RowSource = "Bilgi_Girisi!b3: D" & Cells(65536, 2).End(xlUp).Row
End With

..................................
    SQLStr = "SELECT DISTINCT TCK_NO FROM [DATA$]"    'kynMHBRM dosyada ilgili sat&#305;rlarda sorgu yap
    Dim RecTcNo As ADODB.Recordset:      Set RecTcNo = New ADODB.Recordset
    With RecTcNo
        .Open SQLStr, bagTCKMLK, adOpenKeyset, adLockOptimistic
        .MoveFirst:        ComboBox85.Clear
            For i = 1 To .RecordCount
[color="red"]               
combobox 85, 3 kolonlu olsun 

[B]m&#252;mk&#252;nse bu &#351;ekilde d&#252;zenleyin[/B]
ComboBox85.1kolonu.AddItem .Fields("TCK_NO")  
ComboBox85.2kolonu.AddItem .Fields("ad")  
ComboBox85.3kolonu.AddItem .Fields("soyad")  

[B]OLMAZSA[/B]
ComboBox85.1kolonu.AddItem .Fields("TCK_NO")  
ComboBox85.2kolonu.AddItem i 'd&#246;ng&#252;deki de&#287;er
ComboBox85.3kolonu.AddItem i *100 ''d&#246;ng&#252;deki de&#287;er *100
olsun 


[/color]
               .MoveNext
            Next i
        .MoveFirst:        ComboBox85.ListIndex = 0
        If CBool(.State And adStateOpen) = True Then .Close
    End With
    Set RecTcNo = Nothing
'___________________________

hsayar · 28 Ocak 2008

http://www.excel.web.tr/showthread.php?t=44164 çözüldü

Spreadsheet1 nesnesinde Sıralama

hsayar

Levent Menteşoğlu

Administrator

hsayar

Zeki Gürsoy

Uzman

hsayar

hsayar

Zeki Gürsoy

Uzman

hsayar

Zeki Gürsoy

Uzman

hsayar

Zeki Gürsoy

Uzman

hsayar

hsayar

hsayar

Zeki Gürsoy

Uzman

hsayar

hsayar