Formül yerine makro kullanmak

[seismic]

Otomotiv üreticileri için plastik parçalar üreten bir firmada çalışıyorum ve stok programı olarak "LOGO GO" kullanmaktayız. Siparişler müşterilerden haftalık olarak ve aynı zamanda 3 hafta öngörülü olarak gelmekte. Birkaç excel dosyası ile siparişleri ve planlamayı düzenli şekilde gerçekleştirmeyi başardığımızı söyleyebilirim. Ancak verilen siparişlerin ne kadarının karşılandığını yani sevkiyat performansımızın ne durumda olduğunu görebilmemiz ve dahası verilerin daha doğru kullanılması için gelen siparişlerin LOGO'ya girilmesine karar verdik. Bir SQL sorgusu ile açık olan siparişlerdeki gerekli bilgileri excel'e aktarıyorum. İşte sorun da burada başlıyor.

Logo'ya sipariş girişi yapan kullanıcı ile üretimde planlama yapan kişiler farklı ve çok da iyi excel kullanıcıları olmadığı için, ekteki dosyada "J, K ve L" sütunundaki formüllerin bozulacağından eminim. Bu formülleri incelediğinizde, "http://www.excel.web.tr/f47/mukerrer-kayytlar-ve-kar-ylyklary-t79827.html" sayfasındaki dosyalardan devşirilme olduğunu anlayacaksınız. Bu işlemleri formüller yerine bir makro ile yapmanın yolu var mıdır?

Mutlaka vardır diye düşünüyor ve yardımcı olacak arkadaşlara şimdiden teşekkürlerimi sunuyorum. Dosya üzerinde anlaşılmayan noktalar olduğu taktirde daha fazla açıklama yapabilirim.

 

[Emsdmr]

Makro kullanmanız şartmı? Şart değilse Hücreleri Kilitlemenizi önersem. böylece kodlar zarar görmez

 

[seismic]

Ne yazık ki

Makro kullanmanız şartmı? Şart değilse Hücreleri Kilitlemenizi önersem. böylece kodlar zarar görmez

Ne yazık ki makro kullanmam gerekiyor.

 

[seismic]

Bazen çok zor sorular sorduğumu düşünüyorum. Konu hakkında yardımcı olacak arkadaşlara tekrar teşekkür ederim.

 

[seismic]

Şöyle bir makro buldum sitede ancak planlama sayfasındaki veriler ile sql sayfasındaki verileri karşılaştırıp eşleşenlerin değerlerini J,K ve L sütunlarına yazdıramadım.

 

[seismic]

Bu konuya el atabilecek kimse yok mu?

 

[seismic]

Bari bu dosya üzerindeki kodlarla ilgili birşeyler yapan çıksa..!

 

[usubaykan]

Merhaba;

Aşağıdaki kodu deneyin. Sitemkar olmayın ;-)

Option Explicit
Sub Deneme()
Dim Bul As Range, Adres As String, U As Long, Son_Satır As Long, Sütun As Integer
Application.ScreenUpdating = False
    For U = 3 To [L65536].End(3).Row
    Sütun = 13
        Son_Satır = Sheets("SQL").Range("D65536").End(3).Row
        Set Bul = Sheets("SQL").Range("D3:D" & Son_Satır).Find(Cells(U, "L"), LookAt:=xlWhole)
        If Not Bul Is Nothing Then
            Adres = Bul.Address
            Do
                Cells(U, Sütun) = Cells(Bul.Row, "G")
                Set Bul = Sheets("SQL").Range("D3:D" & Son_Satır).FindNext(Bul)
                If Adres <> Bul.Address Then Cells(U, Sütun + 1) = Cells(Bul.Row, "G")
                Sütun = Sütun + 1
            Loop While Not Bul Is Nothing And Adres <> Bul.Address
        End If
    Next
End Sub

 

[seismic]

Hay Allah razı olsun yaa

 

[usubaykan]

Merhaba;
Cümlemizden razı olsun.

Hay Allah razı olsun yaa

 

[seismic]

Peki bu kodları "Planlama" sayfasında çalıştırıp kontrolü yine "SQL" sayfasında yapması için nasıl bir uyarlama yapmak gerekir? Yani planlama sayfasındaki "A" sütununda bulunan referansları "SQL" sayfasındaki "D" sütunundaki hücreler ile karşılaştırararak, "SQL" sayfasında "G" sütununda bulduğu değerleri "Planlama" sayfasındaki "J, K ve L" sütunlarına yazması için.


Sanırım şöyle bir kod işimizi görecektir:

Option Explicit
Sub Deneme()
Dim Bul As Range, Adres As String, U As Long, Son_Satır As Long, Sütun As Integer
Range("J3:K65536").ClearContents
Application.ScreenUpdating = False
For U = 3 To Sheets("Planlama").Range("A65536").End(3).Row
Sütun = 10
Son_Satır = Sheets("SQL").Range("D65536").End(3).Row
'*************
Set Bul = Sheets("SQL").Range("D3: D" & Son_Satır).Find(Sheets("Planlama").Cells(U, "A"), LookAt:=xlWhole)
'***********
If Not Bul Is Nothing Then
Adres = Bul.Address
Do
Cells(U, Sütun) = Sheets("SQL").Cells(Bul.Row, "G")
'************
Set Bul = Sheets("SQL").Range("D3: D" & Son_Satır).FindNext(Bul)
'************
If Adres <> Bul.Address Then Cells(U, Sütun + 1) = Cells(Bul.Row, "G")
Sütun = Sütun + 1
Loop While Not Bul Is Nothing And Adres <> Bul.Address
End If
Next
End Sub


*** işaretleri arasındaki kodlarda Range("D3: D") yazan noktalarda smiley koyuyor. Boşluk kaldırılırsa kod çalışıyor.