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
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
