Spreadsheet1 nesnesinde Sıralama

H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
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.
 
L

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,058
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
Bir excel sayfasındaki sıralama mantığına benzer bir mantık kullanabilirsiniz.
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
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ı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

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Ctrl + I ile argumanları inceleyin.
Kod: 
Spreadsheet1.Range("a1:f10").Sort _
        6, xlAscending, xlGuess
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
hocam alakanıza teşekkür ederim ama olmadı.
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
ö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
 
Son düzenleme:
Zeki Gürsoy

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
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
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
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ı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

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Listeleme yapılırken hücrebiçimini de verebilirsiniz.
Kod: 
Spreadsheet1.Cells(sat + i, 6).Value = _
FormatDateTime(.Fields("YKN_DOGUM_T"), vbShortDate)
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
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ğum tarihini veritabanından olduğu gibi alı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ı kolona göre sı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

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Hata vermemesi gerekirdi. Bi&#231;imlendirmeyi ilk seferde de yapabilirsiniz.
Kod: 
Spreadsheet1.Columns(6).NumberFormat = "dd/mm/yyyy"
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
te&#351;ekk&#252;rler hocasm bu daha g&#252;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]
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
sn anemos hocam 6. mesajdaki 2 sorum ile igili fikriniz nedir

combobox a 3 kolon atay&#305;p
1 kolona > kapal&#305; dosyadaki tcno,
2 kolona > kapal&#305; dosyadaki ad,
3 kolona > soyad,

getirtilebilirmi
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
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
'___________________________
...................
&#231;al&#305;&#351;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&#305;n&#305;n kapal&#305; dosya versiyonu ama nas&#305;l
 
Zeki Gürsoy

Zeki Gürsoy

Uzman
Uzman
Katılım
31 Aralık 2005
Mesajlar
4,369
Excel Vers. ve Dili
Office 365 (64 bit) - Türkçe
Combonun "Column" &#246;zelli&#287;ini 3 yapt&#305;ktan sonra a&#351;a&#287;&#305;daki gibi eleman ekleyebilirsiniz.
Kod: 
Combobox85.Additem
combobox85.List(0,0)=rs(..)
combobox85.List(0,1)=rs(..)
.
.
 
H

hsayar

Katılım
2 Mart 2005
Mesajlar
2,960
Excel Vers. ve Dili
ev: Ofis 2007- Win Xp
iş: Ofis 2010- Win Vista
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
'___________________________
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst