AccessTr.neT

Tam Versiyon: Kapalı Excel Son Satır No Bulma
Şu anda arşiv modunu görüntülemektesiniz. Tam versiyonu görüntülemek için buraya tıklayınız.
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