Formül yerine kod. Ama dinamik değişen kod olmalı?

[udentr2002]

Merhaba arkadaşlar.

Yapmak istediğim şu Ekli dosyada Proje_Maliyet sayfasında AL4 hücresine kod girildiğinde bu kodu Kodlar sayfasında I stünunda arayıp o bulduğu verinin H stünunda (Yardımcı madde adı) bulup Proje_Maliyet sayfasında AM4 hücresine yazacak bunu ekli dosyadada göreceksiniz çok değerli HÜSEYİN ÇOBAN üstad Sayfanın kod bölümüne yazarak oluşturdu. Bunu aşağıdaki formüllede yapabiliyorduk

=EĞER(EHATALIYSA(İNDİS(Kodlar!$H$2:$H$9003;KAÇINCI(AL4;Kodlar!$I$2:$I$9003;0)));"";(İNDİS(Kodlar!$H$2:$H$9003;KAÇINCI(AL4;Kodlar!$I$2:$I$9003;0))))

Bunun yerine üstad Hüseyin çobanın yapmış olduğu kodlara geçmemizin sebbei bu formülü belki 75 den fazla stüna ve onbinlerce hücreye yazmak zorunda olduğumdan dosyanın kapasitesini çok arttıracaktı. Ondan dolayı o sayfanın kod bölümüne hocamızın hazırlamış olduğu kodları yazarak hallettik. Fakat benim istediğim şu. Diyelimki Kodlar sayfasında bir değişiklik yaptığımızda bu değişikli,ğin dinamik olarak Proje_Maliyet sayfasındaki o kodun karşısına gelen AM4 hücresinde de dinamik olarak değişmesi. Hani hücreye formül olarak girdiğimizde o formülün dinamik olarak çalışması gibi.
Hüseyin hocam bunu ayrı bir konu olarak açmamı istedi bende sizden bu konu hakkında yardımlarınızı rica edecektim.

ekli dosyamı gönderiyorum. İnşallah demek istediğimi anlatabilmişimdir.
Şimdiden ilgilenen tüm arkadaşalrıma çok teşekkür ederim.


Konu başlığını aşağıda veriyorum belki ordan bakarak aklınıza başka fikirler gelebilr diye

[thread]
http://www.excel.web.tr/f48/makro-ile-syra-no-verme-i-lemi-t91117.html
[/thread]

 

[udentr2002]

Böyle bir şeyin imkanı varmı acaba?

Yardımcı olursanız çok sevinirim.

 

[udentr2002]

Bu konuda yardımcı olacak bir hocam varmı lütfen

 

[Orion1]

Bu konuda yardımcı olacak bir hocam varmı lütfen

Olmaz olumu var elbet.
Dosyanız ektedir.

If Not Intersect(Target, Range("AL2:AL65536")) Is Nothing Then
            If Target = "" Then Exit Sub
                Target.Offset(0, 1).ClearContents
                Set k = Sheets("KODLAR").Range("I:I").Find(Target.Value, , xlValues, xlWhole)
                If Not k Is Nothing Then
                    Target.Offset(0, 1).Value = Sheets("KODLAR").Cells(k.Row, "H").Value
                    Else
                    MsgBox " Girdiğiniz Stok Kodu Bulunamadı !", vbCritical, "Dikkat !"
                End If
                
    Else

ilk sayfada:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet, k As Range, adr As String, sat As Long, deg
If Intersect(Target, Range("H2:I65536")) Is Nothing Then Exit Sub
On Error Resume Next
Set sh = Sheets("Proje_maliyet")
sat = sh.Cells(65536, "AL").End(xlUp).Row
If Target.Column = 8 Then
    deg = Cells(Target.Row, "I").Value
    ElseIf Target.Column = 9 Then
    deg = Target.Value
End If
Set k = sh.Range("AL2:AL65536").Find(Cells(Target.Row, "I").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        k.Offset(0, 1).Value = Cells(Target.Row, "H").Value
        Set k = sh.Range("AL2:AL65536").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    Else
    MsgBox "değer Proje maliyet sayfasında bulunamdı", vbCritical, "UYARI"
End If
End Sub

 

[udentr2002]

Hocam öncelikle çok ama çok teşekkür ederim. İlginiz ve emeğiniz için. Allah razı olsun.

Yanlız kodlar sayfasında bir değişiklik yaptıktan sonra bu koda ait değişiklik ancak o hücrenin içine girip çıktıktan sonra kodlar çalışıyor. Bu o hücreyi aktif ederek değilde dinamik olarak değişmesinin bir imkanı varmı?

 

[Emir Hüseyin Çoban]

Merhaba,

Bende bu işlemi yeni öğrendim. Kodları deneyin.
Kodları "kodlar" sayfanızın kod bölümüne yapıştırın.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim BUL As Range, ADRES As String
    If Intersect(Target, Range("H2:H65536")) Is Nothing Then Exit Sub
    If Cells(Target.Row, "I") <> "" Then
    Set BUL = Sheets("Proje_Maliyet").Range("AL:AL").Find(Cells(Target.Row, "I"), LookAt:=xlWhole)

    If Not BUL Is Nothing Then
    ADRES = BUL.Address
    Do
        If Cells(Target.Row, "H") <> BUL.Offset(0, 1) Then BUL.Offset(0, 1) = Cells(Target.Row, "H")

    Set BUL = Sheets("Proje_Maliyet").Range("AL:AL").FindNext(BUL)
    Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
    Set BUL = Nothing
    MsgBox "Kod bilgileri güncellenmiştir.", vbInformation
    End If
End Sub

örnek olarak AL sütunu için düzenledim. Tablonuza göre düzenleyiniz.

 

[Orion1]

Kodları önceki yerde günceeldim.
Dosyayı önceki yerden indirebilirisiniz

ama ilk sayfada kodu silerseniz
ona ait değer 2nci sayfada kalıyor.
Tabii bu durm olabilri .Önce bazı kabuller koymalısınz
bazı yerlerin değişmemsini sağlamılısınz.
iyi bir tasım yapılırsa sorun hallor
ama ben bu şekli ile kulanmanızı tavsiye etmem.
userformdan girin
sayfayı korumaya alın
Kontrol sizde olsun
çalışma sayfalarıda maalesef insaytifi coderler eline zor alıyor
Onun için userformlar kullanrak
sayfayı korumaya alarak
çalışmak dah doğrudur.

 

[udentr2002]

Sayın Hüseyin hocam,

çok ama çok teşekkür ederim. Ellerinize emeğinize bilginize sağlık. Tam dediğim gibi oldu.

Proje_Maliyet sayfasında Evren hocamın kodları ve Kodlar sayfasınada en son sizin göndermiş olduğunuz kodları yazınca sorun hal oldu. Gerçekten çok teşekkür ederim.

Evren hocam ayrıca sizede çok teşekkür ederim ellerinize sağlık. Haklarınızı helal edin.

Not: Benim 10 kadar sayfam vardı ve her sayfada bir sürü stüna bu formülü uygulamak zorundaydım dosya çok fazlası ile kasmaya başlamıştı hele Proje_maliyet sayfasında 100 e yakın stüna ve ddiğim gibi 1000 lerce hücreye o formülü uygulamak zorundaydım. Bu şekilde dosya sanırım açılmayacaktı. Ama sizlerin yardımı ile çözüldü. Tekrar tekrar teşekkürler. artık dosyamda yapmak istediği şeyler için ilerleyebilrim.

 

[Orion1]

Sayın Hüseyin hocam,

çok ama çok teşekkür ederim. Ellerinize emeğinize bilginize sağlık. Tam dediğim gibi oldu.

Proje_Maliyet sayfasında Evren hocamın kodları ve Kodlar sayfasınada en son sizin göndermiş olduğunuz kodları yazınca sorun hal oldu. Gerçekten çok teşekkür ederim.

Evren hocam ayrıca sizede çok teşekkür ederim ellerinize sağlık. Haklarınızı helal edin.

Not: Benim 10 kadar sayfam vardı ve her sayfada bir sürü stüna bu formülü uygulamak zorundaydım dosya çok fazlası ile kasmaya başlamıştı hele Proje_maliyet sayfasında 100 e yakın stüna ve ddiğim gibi 1000 lerce hücreye o formülü uygulamak zorundaydım. Bu şekilde dosya sanırım açılmayacaktı. Ama sizlerin yardımı ile çözüldü. Tekrar tekrar teşekkürler. artık dosyamda yapmak istediği şeyler için ilerleyebilrim.

7nci mesajda yazdığımı okudunuzmu?

 

[udentr2002]

Evren hocam okudum mesajınızı
çok teşekkürler tekrardan. Gerçekten uğraştırdım sizleri.