- Katılım
- 6 Ekim 2004
- Mesajlar
- 250
- Excel Vers. ve Dili
- MSOffice 2010 TR
- Altın Üyelik Bitiş Tarihi
- 19-11-2020
Merhaba ,
Aşağıdaki kod Access veri tabanına ado ile ulaşıp Producttable adındaki tabloda field2 Productname ye bakıyor ve referans verilen excel hücrelerinde ürün adı eşleşiyorsa field4 de Price satırlarını döngü ile cok hızlı bir şekilde değiştirebiliyor. Çok güzel kullanışlı bir kod. Arşivlemek açısından burada paylaşıyorum ayrica bu kodda ihtiyacıma göre revize denedim fakat cok ugrasmama ragmen yapamadım. Yardımcı olabilecek üstad varsa yardımınızı rica ederim.
Bana lazım olanlar :
1) Producttable aynı üründen birden çok varsa Nasil bir kod kullanmaliyim.
2)Hücrelerden döngüyle değiştirme kodlarını bozmadan ayrıca bir makro olarak Sadece ÜrünTextbox1 deki ürün ismini kontrol edip PriceCombobox1 deki değerle değitirecek ikinci bir modül e ihtiyacım var.
https://software-solutions-online.com/updating-tables-access-database-using-excel-vba/?unapproved=1103&moderation-hash=121f3101d0fa4e3a0243c93a0063f8fa#comment-1103
Sub updateAccess()
Dim cn As ADODB.Connection
Dim rstProducts As ADODB.Recordset
Dim sProduct As String
Dim cPrice As String
Dim counter As Integer
Application.DisplayAlerts = False
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Products.accdb;Persist Security Info=False;"
cn.Open
Set rstProducts = New ADODB.Recordset
With rstProducts
.Open "ProductTable", cn, adOpenKeyset, adLockPessimistic, adCmdTable
End With
sProduct = Sheet1.Cells(2, 1).Value ' row 1 contains column headings
counter = 0
Do While Not sProduct = ""
sProduct = Sheet1.Cells(2 + counter, 1).Value
cPrice = Sheet1.Cells(2 + counter, 2).Value
rstProducts.Filter = "ProductName = '" & sProduct & "'"
If rstProducts.EOF Then
rstProducts.AddNew
rstProducts("rstProducts!ProductName").Value = sProduct
rstProducts("rstProducts!Price").Value = cPrice
Else
rstProducts!Price = cPrice
End If
rstProducts.Update
counter = counter + 1
sProduct = Sheet1.Cells(2 + counter, 1).Value
Loop
rstProducts.Close
Set rstProducts = Nothing
cn.Close
Set cn = Nothing
Application.DisplayAlerts = True
End Sub
teşekkürler , saygılar ,
Aşağıdaki kod Access veri tabanına ado ile ulaşıp Producttable adındaki tabloda field2 Productname ye bakıyor ve referans verilen excel hücrelerinde ürün adı eşleşiyorsa field4 de Price satırlarını döngü ile cok hızlı bir şekilde değiştirebiliyor. Çok güzel kullanışlı bir kod. Arşivlemek açısından burada paylaşıyorum ayrica bu kodda ihtiyacıma göre revize denedim fakat cok ugrasmama ragmen yapamadım. Yardımcı olabilecek üstad varsa yardımınızı rica ederim.
Bana lazım olanlar :
1) Producttable aynı üründen birden çok varsa Nasil bir kod kullanmaliyim.
2)Hücrelerden döngüyle değiştirme kodlarını bozmadan ayrıca bir makro olarak Sadece ÜrünTextbox1 deki ürün ismini kontrol edip PriceCombobox1 deki değerle değitirecek ikinci bir modül e ihtiyacım var.
https://software-solutions-online.com/updating-tables-access-database-using-excel-vba/?unapproved=1103&moderation-hash=121f3101d0fa4e3a0243c93a0063f8fa#comment-1103
Sub updateAccess()
Dim cn As ADODB.Connection
Dim rstProducts As ADODB.Recordset
Dim sProduct As String
Dim cPrice As String
Dim counter As Integer
Application.DisplayAlerts = False
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Products.accdb;Persist Security Info=False;"
cn.Open
Set rstProducts = New ADODB.Recordset
With rstProducts
.Open "ProductTable", cn, adOpenKeyset, adLockPessimistic, adCmdTable
End With
sProduct = Sheet1.Cells(2, 1).Value ' row 1 contains column headings
counter = 0
Do While Not sProduct = ""
sProduct = Sheet1.Cells(2 + counter, 1).Value
cPrice = Sheet1.Cells(2 + counter, 2).Value
rstProducts.Filter = "ProductName = '" & sProduct & "'"
If rstProducts.EOF Then
rstProducts.AddNew
rstProducts("rstProducts!ProductName").Value = sProduct
rstProducts("rstProducts!Price").Value = cPrice
Else
rstProducts!Price = cPrice
End If
rstProducts.Update
counter = counter + 1
sProduct = Sheet1.Cells(2 + counter, 1).Value
Loop
rstProducts.Close
Set rstProducts = Nothing
cn.Close
Set cn = Nothing
Application.DisplayAlerts = True
End Sub
teşekkürler , saygılar ,