Cvp: Kapalı Excel Son Satır No Bulma - feraz - 07/03/2020
Alttaki kod ilede Access kodlarına uyarladım.Yani Access butonuna tıklayınca kapalı exceldeki veriler bulunuyor.
Kod:
Option Compare Database
Private Sub Komut0_Click()
Dim TamAd As String
Set excel = CreateObject("Excel.Application")
TamAd = "'" & CurrentProject.Path & "\[kapali.xlsx]Sayfa1'!"
MsgBox Mid(TamAd, 2, Len(TamAd) - 3) & vbNewLine & "-----------------" & vbNewLine & "A Sütunu Son Satir Numarasi: " & excel.Application.ExecuteExcel4Macro("LOOKUP(2,1/(" & TamAd & "C1<>""""),ROW(" & TamAd & "C1))") & _
vbNewLine & "A Sütunu Son Deger: " & excel.Application.ExecuteExcel4Macro("LOOKUP(2,1/(" & TamAd & "C1<>"""")," & TamAd & "C1)")
Set excel = Nothing
End Sub
Cvp: Kapalı Excel Son Satır No Bulma - berduş - 07/03/2020
teşekkürler sayın @feraz ben hâlâ ADO'dan uçarı kaçarı var mı onunla uğraşıyorum)
Cvp: Kapalı Excel Son Satır No Bulma - feraz - 07/03/2020
Rica ederim abey.
Ado da MoveFirst ve MoveLast olayları işi karıştırıyor.
Öncedende dediğim giibi herhangi bir ilk satır doluysa zaten sorun yok.
Cvp: Kapalı Excel Son Satır No Bulma - berduş - 09/03/2020
Bu da Ado yöntemi
öncelikle bir modül oluşturup aşağıdaki kodları yapıştırın
Public IlkHcr, SonHcr As String
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
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
gerisi fonksiyonu Excel Adı_adresi ve sayfa adını metin formatında girerek çağırmak
SonVeIlkHucre "C:\Users\isa\Desktop\Son satir Excel\bilgiler2.xls","Sayfa4"
gibi
Cvp: Kapalı Excel Son Satır No Bulma - feraz - 09/03/2020
Berduş hocam bu işte bir gariplik var sanki
Daha önce sizden öğrendiğim yöntemle kod çalıştır ekledim.
Çalıştırınca resimdeki gibi sonuç çıkıyor.
Normalde A sütunu için sadece 28 numarası verilmeli bu mid ile yapılabilir.Lakin neden D sütunu çıktı piyasaya.
Sizin için Excel dosyasıda hazırladım kapalı olarak.
Cvp: Kapalı Excel Son Satır No Bulma - berduş - 09/03/2020
gönderdiğiniz dosya exceli açıp ctl+End yaparsanız yani son satıra git derseniz o da D28e gidiyor, amaç exceldeki son hücreyi bulmak ve Excel son hücreyi veri olan son Sütun ve Veri Olan son Satır olarak belirliyor, yanılıyor muyum?
|