ADO ile bağlandığım dosyada işlem yaptırmak

[ibere]

Merhaba dostlar,

ado ile bağlandığım dosyada

If Cells(1, 1) <> "SIRA NO" Then
Rows("1:2").Select
Selection.Delete Shift:=xlUp
End If

bu kodu çalıştırdıktan sorgu yapmak istiyorum. Bu kodu ado ile baglandıgım dosyada nasıl çalıştırabilirim acaba ?

Bu kodu ado ile baglandıgım dosyada işletip sorgu yaptırmak istiyorum

 

[Erdem Akdemir]

Merhaba,

ADO ile görsel işlem yapamazsınız. Verilerinizi okuyabilir, düzeltebilir, excel hariç silebilirsiniz.

 

[Korhan Ayhan]

Bence örnek dosyalarınızı paylaşıp yapmak istediğiniz işlemi açıklarsanız alternatif çözümler önerilebilir.

 

[ibere]

Sorunumu çözdüm, teşekkür ederim herbirinize.

Kullandığım kodlar belki birinin işine yarar diye buradan paylaşmak istiyorum.

Private Sub CommandButton1_Click()
Range("A1:N500").Clear
Dim baglanti As New ADODB.Connection
Dim rs As New ADODB.Recordset

Uzanti = ".xlsx"
klasörünadi = ThisWorkbook.Path
dosyaninadi = "kaynak" & Uzanti
yol = klasörünadi & "\" & dosyaninadi

baglanti.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
yol & ";extended properties=""Excel 12.0;hdr=yes"""

aranan = Range("p5")
Sorgu = "Select * FROM [ExcelSablonu$A3:N500] where [GELDİĞİ YER]='" & aranan & "'"
rs.Open Sorgu, baglanti, adOpenKeyset, adLockPessimistic

a = 1
For Each baslik In rs.Fields
Cells(1, a) = baslik.Name
a = a + 1
Next baslik


Range("A2").CopyFromRecordset rs


rs.Close
baglanti.Close
End Sub

 

[alicimri]

ADO Update ile tek sütun için satır kaldırma kodları aşağıda, A1 hücresini "SIRA NO" için test edip işlem yapıyor. Diğer sütunlar için kendiniz uyarlayın.

Sub Makro1()
    Dim Dosya As String, Baglanti As Object
    Set Baglanti = CreateObject("AdoDb.Connection")
    Dosya = ThisWorkbook.Path & "\kaynak.xlsx"
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
  Set rs = CreateObject("adodb.recordset")
  sorgu = "select* from [Sayfa1$]"
 rs.Open sorgu, Baglanti, 1, 3
 If rs("F1") <> "SIRA NO" Then
rs.movenext
rs.movenext
For i = 1 To rs.RecordCount - 2
dizi = dizi & "," & rs("F1")
rs.movenext
Next
dizi = Split(dizi, ",")
rs.movefirst
For e = 1 To rs.RecordCount
If e = rs.RecordCount Or e = rs.RecordCount - 1 Then
rs("F1").Value = ""
rs.Update
Else
rs("F1").Value = dizi(e)
rs.Update
End If
rs.movenext
Next
End If
    Set Baglanti = Nothing
Set rs = Nothing
End Sub

 

[ibere]

ADO Update ile tek sütun için satır kaldırma kodları aşağıda, A1 hücresini "SIRA NO" için test edip işlem yapıyor. Diğer sütunlar için kendiniz uyarlayın.

Sub Makro1()
    Dim Dosya As String, Baglanti As Object
    Set Baglanti = CreateObject("AdoDb.Connection")
    Dosya = ThisWorkbook.Path & "\kaynak.xlsx"
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
  Set rs = CreateObject("adodb.recordset")
  sorgu = "select* from [Sayfa1$]"
rs.Open sorgu, Baglanti, 1, 3
If rs("F1") <> "SIRA NO" Then
rs.movenext
rs.movenext
For i = 1 To rs.RecordCount - 2
dizi = dizi & "," & rs("F1")
rs.movenext
Next
dizi = Split(dizi, ",")
rs.movefirst
For e = 1 To rs.RecordCount
If e = rs.RecordCount Or e = rs.RecordCount - 1 Then
rs("F1").Value = ""
rs.Update
Else
rs("F1").Value = dizi(e)
rs.Update
End If
rs.movenext
Next
End If
    Set Baglanti = Nothing
Set rs = Nothing
End Sub

Çok makbule geçti, teşekkür ederim.