Kapalı Dosyanın Kolonunda bulunan verileri değiştirmek.

[Hacı Bayram ÖZKAN]

Merhaba arkadaşalar; iki adet dosyam var Kapalı dosyam PERSONEL LİSTESİ dosyam bilgisayarımın D:\Belgelerim\Personel\PERSONEL LİSTESİ.xlsm" konumunda bulunmaktadır. Açık olan dosyam üzerinden kapalı dosyamda bulunan personelin sicili ile karşılaştırarak S kolonundaki durumunu AÇIK dosyam üzerinden değiştirmem mümkün müdür? Ayrıntısını dosya üzerinde belirttim. Teşekkür ederim.

 

[N.Ziya Hiçdurmaz]

merhaba; aşağıdaki kodu kullanabilirsiniz.
Sub deneme()
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
Yol = "C:\Users\isko1proses\Desktop\test\PERSONEL LİSTESİ.xlsm"
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & Yol & ";extended properties=""excel 12.0;hdr=yes"""
rs.Open "select * from [LİSTE$];", con, 1, 3
If Not rs.EOF Then
Do While Not rs.EOF
If rs.Fields.Item("Sicili").Value = [AX7] Then
rs.Fields.Item("EK ÜCRET") = [BA7]
End If
rs.MoveNext
Loop
End If
Set rs = Nothing: Set con = Nothing
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın Niyazi bey; Öncelikle eline sağlık efendim bizim için zahmet buyurdunuz, Kod çalıştı ancak benim isteğim gibi değil bunu düzeltirseniz sevinirim.
Bu haliyle sadece BA7'ye yazılan veriyi PERSONEL LİSTESİ dosyasının LİSTE sayfasında bulup sadece bunu değiştiriyor, oysa ben efendim; BA7 kolonundan başlayarak alt alta yazdığım VERİLECEK kelimesini AX7 kolonunda bulunan sicilli PERSONEL LİSTESİ dosyasının LİSTE sayfasının S Kolonu yani "EK ÜCRET" kolonunda daha önce yazılı olan verileri değiştirerek VERİLECEK yazmasını istiyorum. örnek dosyamda olduğu gibi sonucunda da 11 PERSONELİN EK ÜCRET BİLGİSİ DEĞİŞTİRİLMİŞTİR. Mesajı yanı 11 tane değişiklik yapacak efendim bu şekilde olabilirse çok memnun olurum.

 

[N.Ziya Hiçdurmaz]

merhaba bayram bey; aşağıdaki gibi deneyiniz.

Sub deneme()
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
Yol = "C:\Users\isko1proses\Desktop\test\PERSONEL LİSTESİ.xlsm"
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & Yol & ";extended properties=""excel 12.0;hdr=yes"""
rs.Open "select * from [LİSTE$];", con, 1, 3
If Not rs.EOF Then
Do While Not rs.EOF
For sat = 7 To Cells(Rows.Count, "ax").End(xlUp).Row
If rs.Fields("Sicili") = Cells(sat, "ax") And Cells(sat, "ba") <> "" Then
rs.Fields("EK ÜCRET") = Cells(sat, "ba")
End If
Next sat
rs.MoveNext
Loop
End If
Set rs = Nothing: Set con = Nothing
End Sub

 

[Hacı Bayram ÖZKAN]

Sayın abim eline sağlık çok teşekkür ederim. Rica etsem vaktiniz olduğunda 11 adet ya mesajla bunu saydıra bilir miyiz?
Mesaj 11 PERSONELİN EK ÜCRET BİLGİSİ DEĞİŞTİRİLMİŞTİR diye bir mesaj aldırabilir miyiz? Tekrar teşekkür ederim.

 

[N.Ziya Hiçdurmaz]

Sub deneme()
Set con = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
Yol = "C:\Users\isko1proses\Desktop\test\PERSONEL LİSTESİ.xlsm"
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & Yol & ";extended properties=""excel 12.0;hdr=yes"""
rs.Open "select * from [LİSTE$];", con, 1, 3
If Not rs.EOF Then
Do While Not rs.EOF
For sat = 7 To Cells(Rows.Count, "ax").End(xlUp).Row
If rs.Fields("Sicili") = Cells(sat, "ax") And Cells(sat, "ba") <> "" Then
rs.Fields("EK ÜCRET") = Cells(sat, "ba")
End If
Next sat
rs.MoveNext
Loop
End If
Set rs = Nothing: Set con = Nothing
say = WorksheetFunction.CountIf(Range("ba7:ba" & Cells(Rows.Count, "ba").End(xlUp).Row), "<>")
MsgBox say & " PERSONELİN EK ÜCRET BİLGİSİ DEĞİŞTİRİLMİŞTİR"
End Sub

 

[Hacı Bayram ÖZKAN]

Teşekkür ederim abim ellerine sağlık iyi günler dua ile kal.

Çok güzel olmuş ve hızlı çalışıyor.

 

[Hacı Bayram ÖZKAN]

Sayın Niyazi Hocam; sizin yazdığınız koda bir ekleme daha yapabilir miyiz. İhtiyaç duydumda. Zahmet olmaz ise eğer; yada yardımcı olacak diğer arkadaşlarda yardım ederse minnetar kalırım.
Açık Dosyamın bu seferde BB7 kolonuna yazdığım veriyi Kapalı dosyamda sicilden bularak S kolonuna Açıklama şeklinde yazdıra bilir miyiz.
Teşekkür ederim.