AccessTr.neT

Sayfalar: 1 2 3 4 5 6

Abey A sütunu için son satır numara gerek.Sonra isteğe göre B yada herhangi bir sütun adı olabilir.

Yani ben sayfanın genelinde değilde belirili sütundakininkini istirem.

kodun çalışma mantığını açıklayayım
1 - önce sayfada veri var mı? diye bakıyor varsa:
2 - kayıt ve Alan Sayısını buluyor
3 - A sütunundan başlayarak dolu olan ilk sütunu bulana kadar sütunları dolaşıyor
4 - bulduğu ilk veri olan sütunu Başlangıç Sütunu olarak kaydediyor, Son Sütun=Başlangıç sütunu + Alan Sayısı -1
5 - ilk satırdan başlayarak veri olan ilk satıra kadar tüm satırları tek tek kontrol ediiyor, ilk satırı Başlangıç satırı olarak kaydediyor
son satır zaten kayıt sayısı-1 eklenerek hesaplanıyor

Sütunların bulunduğu döngüyü devre dışı bırakıp sadece belirlediğiniz sütunu bulacak şekilde düzenleyebilirsiniz

Tamam akşama bakarım ve hallederim.

Sayın berduş hocam giftede gösterdiğim gibi recordcount nasıl çıkıyor.Normalde A sütunu ekledim koda B sütununa birşey yazıncada ondaki veriye görede değişiyor.

[Resim: do.php?img=9820]

Option Compare Database



Dim Rs As Object

Dim Con  As Object

Dim sConn As String

Dim KayitSayisi As Integer

Dim KitapAdVeYol As String





Public Function test()

    Call SonHucreNo

End Function



Function SonHucreNo()



    KitapAdVeYol = CurrentProject.Path & "\kapali.xlsx"

    'On Error Resume Next

    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & KitapAdVeYol & "" & _

                ";Extended Properties=""Excel 12.0 Xml;HDR=No;imex=1"";"

    

    Set Con = CreateObject("Adodb.Connection")

    Con.Open sConn

    

    sSql = "select f1 from [Sayfa1$A:A]"

    

    Set Rs = CreateObject("adodb.recordset")

    

    Rs.Open sSql, Con, 3, 1

    KayitSayisi = Rs.RecordCount



    Rs.Close

    Con.Close

    Set Rs = Nothing

    Set Con = Nothing

    



End Function

Tüm sayfada ilk ve son hücreyi bulma
SonVeIlkHucre "DosyaAdresVeAdı", "ExcelSayfaAdı"

Function SonVeIlkHucre(txtDosyaAdres As String, txtExcelSyf As String)



If txtDosyaAdres = "" Or txtExcelSyf = "" Then Exit Function



Dim Rs As Object

Dim Con  As Object

    

    Dim sConn As String, sConn2 As String

    Dim KytSay, StRBas, StNBasN  As Long

    Dim AlanSay As Integer

    

        txtExcelSyf = txtExcelSyf & "$"

        KytSay = 0

        AlanSay = 0

        

        StRBas = 1

        StNBasN = 1

        

On Error Resume Next

    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & txtDosyaAdres

    sConn2 = ";Extended Properties=""Excel 12.0 Xml;HDR=No;imex=1"";"

    

Set Con = CreateObject("Adodb.Connection")

    Con.Open sConn & sConn2



      sSql = "select * from [" & txtExcelSyf & "]"



Set Rs = CreateObject("adodb.recordset")

        

        Rs.Open sSql, Con, 3, 1



    If Rs.RecordCount = 0 Then Exit Function

    Rs.MoveLast

        

'txtDosyaAdres xlsm,xlsx=XFD,

        KytSay = Rs.RecordCount

        AlanSay = Rs.Fields.Count

 

    Set Rs = Nothing

'hy___Sütun Başlangıç

x = 1

Do While 1 = 1

 y = 0

 StNBas = ColumnLetter(CLng(x))

 HcrAralik = StNBas & ":" & StNBas

 y = 0

 sSql = "select * from [" & txtExcelSyf & HcrAralik & "]"



Set Rs = CreateObject("adodb.recordset")

    Rs.Open sSql, Con, 3, 1

    

    y = Rs.RecordCount



    If y > 0 Then Exit Do

    x = x + 1

    StNBasN = x



Loop

  

'hy___SatırBaşlangıç

x = 1

    StNBit = StNBasN + AlanSay - 1

    ExcStn = ColumnLetter(CLng(StNBit))



Do While 1 = 1

y = 0



 HcrAralik = "A1" & ":" & ExcStn & x

 sSql = "select * from [" & txtExcelSyf & HcrAralik & "]"



Set Rs = CreateObject("adodb.recordset")

    Rs.Open sSql, Con, 3, 1

    

    y = Rs.RecordCount

    If y > 0 Then Exit Do

    x = x + 1

    StRBas = x '        KytSay,  AlanSay, StRBas, StNBasN

  

Loop



Rs.Close

Con.Close

Set Rs = Nothing

Set Con = Nothing



    StNBit = StNBasN + AlanSay - 1

    StRBit = StRBas + KytSay - 1



IlkHcr = StNBas & StRBas

SonHcr = ColumnLetter(CLng(StNBit)) & StRBas + KytSay - 1



MsgBox "ilk Hücre : " & IlkHcr & vbCrLf & _

      "Son Hücre : " & SonHcr



End Function



'aşağıdaki fonksiyon rakamı Sütuna çevirmek için

Function ColumnLetter(ColumnNumber As Long) As String

    Dim n As Long

    Dim c As Byte

    Dim s As String



    n = ColumnNumber

    Do

        c = ((n - 1) Mod 26)

        s = Chr(c + 65) & s

        n = (n - c) \ 26

    Loop While n > 0

    ColumnLetter = s

End Function

sadece seçilen sütundaki ilk hücre ve değeri ile son hücre ve değeri
SonHucre "ExcelDosyaAdıVeYolu","SayfaAdı","Sütun"

Function SonHucre(txtDosyaAdres As String, txtExcelSyf As String, StNBas As String)



If txtDosyaAdres = "" Or txtExcelSyf = "" Or StNBas = "" Then Exit Function



Dim Rs As Object

Dim Con  As Object

    

    Dim sConn As String, sConn2 As String

    Dim KytSay, StRBas  As Long

    Dim AlanSay As Integer

    

        txtExcelSyf = txtExcelSyf & "$"

        KytSay = 0

        AlanSay = 0

        

        StRBas = 1

        

On Error Resume Next

    sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & txtDosyaAdres

    sConn2 = ";Extended Properties=""Excel 12.0 Xml;HDR=No;imex=1"";"

    

Set Con = CreateObject("Adodb.Connection")

    Con.Open sConn & sConn2



 HcrAralik = StNBas & "1:" & StNBas



      sSql = "select * from [" & txtExcelSyf & HcrAralik & "]" ' where [F1]<>''"



Set Rs = CreateObject("adodb.recordset")

        

        Rs.Open sSql, Con, 3, 1



    If Rs.RecordCount = 0 Then

        MsgBox "Veri Bulunamadı"

        Exit Function

    End If

    Rs.MoveLast

        

        KytSay = Rs.RecordCount

        Rs.Close

    Set Rs = Nothing



'hy___SatırBaşlangıç

x = 1



Do While 1 = 1

y = 0



 HcrAralik = StNBas & x & ":" & StNBas & x

 sSql = "select * from [" & txtExcelSyf & HcrAralik & "]"



Set Rs = CreateObject("adodb.recordset")

    Rs.Open sSql, Con, 3, 1

    

    y = Rs.RecordCount

    If y > 0 Then

        Rs.MoveLast

        ilkDgr = Nz(Rs(0), "")

        If ilkDgr <> "" Then Exit Do

    End If

    x = x + 1

    StRBas = x '        KytSay,  AlanSay, StRBas, StNBasN



Rs.Close

Loop



'hy___SonSatır

    StRBit = StRBas + KytSay - 1

    x = StRBit

Do While 1 = 1

y = 0



 HcrAralik = StNBas & x & ":" & StNBas & StRBit

 sSql = "select * from [" & txtExcelSyf & HcrAralik & "] where [f1]<>''"



Set Rs = CreateObject("adodb.recordset")

    Rs.Open sSql, Con, 3, 1

    

    y = Rs.RecordCount

'    Debug.Print y, sSql

    If y > 0 Or x = 0 Then

        If y > 0 Then

            Rs.MoveLast

            SonDgr = Rs(0)

        End If

        Exit Do

    End If

    x = x - 1

    StRBit = x

Rs.Close

Loop



Rs.Close

Con.Close

Set Rs = Nothing

Set Con = Nothing





IlkHcr = StNBas & StRBas

SonHcr = StRBit



MsgBox "ilk  Hücre -> " & IlkHcr & " : " & ilkDgr & vbCrLf & _

      "Son Hücre -> " & StNBas & SonHcr & " : " & SonDgr

'SonHucre "C:\Users\isa\Desktop\Son satir Excel\bilgiler2.xls","sayfa4","b"

End Function

Sayfalar: 1 2 3 4 5 6

feraz

berduş

berduş

feraz

feraz

berduş