2 listedeki verileri uygun karşılığa koymak

[cemo26]

2 tane tablom var. bunlardan bir tanesi databese burada 1. kolonda 100 den 1000'e kadar sayılar var. 2. kolonda bu sayılara karşılık gelen derece cinsinden ısı değerleri var.

Bilgisayardan özel bir programla data topluyorum, bu program datalar 1. kolondaki değerlerden topluyor. topladağım datalarda bu şekilde 5 tane kolon var. Bir makro yazmam gerekiyorki benim veri tablomdaki değerlere karşık gelen dereceleri topladığım data dosyasından otomatik olarak değiştirebilsin.
Topladığım dataların satırları değişebiliyor.

Yapmak istediğm aslında 2 dosyayı açıp, (her seferinde veri dosyalarımın ismi değişik oluyor), veri tabanı dosyasına konulabilecek bir tuş veya makro ile bu değişiklikleri otomatik yaptırabilmek.örnek olarak size 2 excel dosyasınıda gönderiyorum.

Yardımcı olabilecek arkadaşlarıma şimdiden teşekkür ederim. Kolay gelsin.

 

[cemo26]

Arkadaşlar yardımlarınızı bekliyorum. Teşekkürler.

 

[Recep İpek]

Sorunuzu tam olarak anlamaya çalışıyorumda;
Siz Data dosyasındaki değerleri veritabanındaki derece karşılıkları ile güncellemek mi istiyorsunuz?

Örneğin 637 yerine 43 derece yazacak.

Eğer bu şekilde ise aşağıdaki kodları kullanabilirisiniz.

Not Data dosyasında verilerin bulunduğu sayfanın adı data olması gerekiyor.Bazı bölümleri daha da geliştirilebilinir.

Sub Güncelle()
'On Error Resume Next
Dim Baglanti As ADODB.Connection
Dim Kayit1 As ADODB.Recordset
Dim FSO As Object
Dim SQLStr, Kaynak As String
Kaynak = Application.ActiveWorkbook.Path & "/" & "Datadosyası.xls"
SQLStr = "SELECT * FROM [data$b1:f20000]"
Set Baglanti = CreateObject("ADODB.Connection")
    With Baglanti
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Extended Properties").Value = "Excel 8.0"
        .Properties("Data Source").Value = Kaynak
        .CursorLocation = adUseClient
        .Mode = adModeReadWrite
        .Open
    End With
    If Err = 0 Then
    Set Kayit1 = CreateObject("ADODB.Recordset")
    With Kayit1
        .ActiveConnection = Baglanti
        .CursorLocation = adUseServer
        .CursorType = adOpenKeyset
        .LockType = adLockOptimistic
        .Source = SQLStr
        .Open
    End With
 '***********************************************************************
    If Kayit1.RecordCount > 1 Then
    With Kayit1
    If Not .EOF Then
        .MoveFirst
        Do While Not .EOF
            For i = 0 To .Fields.Count - 1
            If .Fields.Item(i).Value >= 100 And .Fields.Item(i).Value <= 1000 And .Fields.Item(i).Value <> "" Then
            .Fields.Item(i).Value = Application.WorksheetFunction.VLookup(.Fields.Item(i).Value, [a2:b2000], 2, False)
            .Update
            say = say + 1
            End If
            Next i
            .MoveNext
        Loop
    End If
     MsgBox "Kayıtlar Başarıyla Güncellendi." & Chr(10) & Chr(10) & "Toplam Güncellenen Kayıt Sayısı : " & say, vbInformation, "Bilgi"
     End With
    Else
    MsgBox "Kayıt Bulunamadı.", vbInformation, "Bilgi"
    End If
Else
Son:
    MsgBox "Bağlantı Hatası.Kontrol Ediniz", vbInformation, "Bilgi"
End If
 
If CBool(Kayit1.State And adStateOpen) = True Then Kayit1.Close
Set Kayit1 = Nothing
If CBool(Baglanti.State And adStateOpen) = True Then Baglanti.Close
Set Baglanti = Nothing
End Sub

 

[cemo26]

Hocam ilgine çok teşekkür ederim. Sorumu çok doğru yorumlamışsınız. Makroyu anlamaya çalışıyorum Döngüde Vlookup'la bulunan verileri nereye attığını bulamadım. (yazdığını) Birde "datadosyası.xls" yerine bana dosya ismini sorabilir mi? Ben de herzaman değişen Dosya ismini alıp buraya kopyalasam olabilir mi?
Çok teşekkür ederim, saygılarımla.
Cem Özdemir.

 

[Recep İpek]

Veriler diğer dosyadan ADO recordset ile alındığı için direk Update ile günceleniyor.

Sabit dosya yerine istediğiniz klasörden seçmek için kodları aşağıdaki şekilde değiştiriniz.

Fakat sayfa adı data veya sizin istediğiniz sabit bir isim olması gerekiyor.(Buda yapılırda fazla bir adım olur.)

Sub Güncelle()
'On Error Resume Next
Dim Baglanti As ADODB.Connection
Dim Kayit1 As ADODB.Recordset
Dim FSO As Object
Dim SQLStr As String
Kaynak = Application.GetOpenFilename("Excel Dosyası (*.xls),*.xls", , "Hedef Dosyayı Seçiniz")
If Kaynak = False Then Exit Sub
SQLStr = "SELECT * FROM [[B]data[/B]$b2:f20000]"
Set Baglanti = CreateObject("ADODB.Connection")
With Baglanti
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Properties("Extended Properties").Value = "Excel 8.0"
.Properties("Data Source").Value = Kaynak
.CursorLocation = adUseClient
.Mode = adModeReadWrite
.Open
End With
If Err = 0 Then
Set Kayit1 = CreateObject("ADODB.Recordset")
With Kayit1
.ActiveConnection = Baglanti
.CursorLocation = adUseServer
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Source = SQLStr
.Open
End With
'***********************************************************************
If Kayit1.RecordCount > 0 Then
With Kayit1
If Not .EOF Then
.MoveFirst
Do While Not .EOF
For i = 0 To .Fields.Count - 1
If .Fields.Item(i).Value >= 100 And .Fields.Item(i).Value <= 1000 And .Fields.Item(i).Value <> "" Then
.Fields.Item(i).Value = Application.WorksheetFunction.VLookup(.Fields.Item(i).Value, [a2:b2000], 2, False)
.Update
say = say + 1
End If
Next i
.MoveNext
Loop
End If
MsgBox "Kayıtlar Başarıyla Güncellendi." & Chr(10) & Chr(10) & "Toplam Güncellenen Kayıt Sayısı : " & say, vbInformation, "Bilgi"
End With
Else
MsgBox "Kayıt Bulunamadı.", vbInformation, "Bilgi"
End If
Else
Son:
MsgBox "Bağlantı Hatası.Kontrol Ediniz", vbInformation, "Bilgi"
End If
 
If CBool(Kayit1.State And adStateOpen) = True Then Kayit1.Close
Set Kayit1 = Nothing
If CBool(Baglanti.State And adStateOpen) = True Then Baglanti.Close
Set Baglanti = Nothing
End Sub

 

[hsayar]

hayırlı akşamlar hocam.
SQLStr = "SELECT * FROM [data$b1:f20000]"

ne anlama geliyor.
http://www.excel.web.tr/showthread.php?t=58302
lin knde bir sorunum var çöüzüm gelmiyor aklmıa.

 

[Recep İpek]

data sayfasındaki b1 ile f20000 satırları arasındaki tüm bilgileri seç.

 

[cemo26]

Çok Teşekkür

Hocam ellerine sağlık mükemmel olmuş. Yardımların için çok sağol.
Selamlar, kolay gelsin.

 

[cemo26]

Hocam birkaç ilave daha istiyeceğim mümkün mü?

Recep hocam merhaba;
Program için çalışma sayfasının isimini data olarak girmmiz gerekiyordu. Benim topladığım datalarda program dosya ismini uzantısız olarak sheet'e de veriyor. dosya ismi veri.xls ise sheet şismi de veri oluyor. Bu detayı kullanarak isim değişikliği yapmadan makroyu çalıştırabilir miyiz? Biraz fazla oluyorum özür dilerim, data dosyasındaki eski veriler kaybolmasın, sutunları hemen yanına kopyalayıp buradaki verilerin güncellenmesini. başlıklarında veri tabanında bulunan mesela c1:c6 ya kadar olan hücrelerde yazılı başlıklar ile değiştirilmesi nasıl yapılır? Yardımlarınız için teşekkür ederim, kolay gelsin.
Cem Özdemir