düşey ara formülünü macroya çevirme

[abdullahss]

=EĞER(A9="";"";((DÜŞEYARA(A9;Sipariş!A;2;0))))
formülü macroya nasıl çevirebilirim bilgisi olan arkadaşlar yardımcı olabilirmi.

 

[programer]

Forumda arama yapsanız daha iyi olurdu. Bununla ilgili bir çok örnek bulabilirsiniz

 

[abdullahss]

sayın programer aradım tabiki ama macro bilgim sınırlı çok az o nedenle yardım istedim.

 

[Ömer]

Merhaba,

Formülü hesaba katmadan, örnek bir dosya ekleyerek yapmak istediğiniz açıklarmısınız.

 

[abdullahss]

Ömer bey dosyamda çok fazla formül olduğu için çok yavaşlıyor formüllerimi macro olarak yapmak istiyorum.

 

[Ömer]

Sayın abdullahss,

İnanın dosyanızın içinde kayboldum. Lütfen sorunu örnek teşkil etmesi için 5-10 satırlık veriler ile hazırlayıp yeni bir dosya ile sorunuz. Gelecek cevabı siz ana dosyanıza uyarlarsınız.

 

[abdullahss]

Ömer bey sipariş sayfasına girdigim veriler sabit, planlama sayfasında a sütununa veri girerek yani edes no b,c,d,e,f sütunlarını sipariş saydasından otomatik alıyorum burdaki formülleri macro olarak yapmak istiyorum
kesim adetleri sayfasındada aynı planlama sayfasındakı gibi a sütununa eds numarasını girdigimde verileri sipariş sayfasından alıyor.sayfaların a sütunlarında işlem yaparsanız sipariş sayfasındaki a sütunundaki numaralarla mantıgı anlıyacaksınız ilginize teşekkürler.

 

[Ömer]

Planlanan sayfasındaki kodu silerek aşağıdaki kodu kullanın.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Set Sp = Sheets("Sipariş")
    
    If Target.Column = 26 Then
        x = Target.Offset(0, -25)
        GEC3
    End If
    
    If Target.Column = 1 Then
        If Target = "" Then Exit Sub
        Set c = Sp.[A:A].Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Sp.Range("B" & c.Row & ":F" & c.Row).Copy Cells(Target.Row, "B")
        End If
    End If
        
End Sub

Kesim_Adet sayfasında ise eski change kodlarını aşağıdakilerle değiştirin.

Private Sub Worksheet_Change(ByVal Target As Range)
 
    If Target.Column = 17 Then
        ActiveWorkbook.Save
        Sheets("Sipariş").Select
    End If
    Set Sp = Sheets("Sipariş")
    If Target.Column = 1 Then
        If Target = "" Then Exit Sub
        Set c = Sp.[A:A].Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Sp.Range("B" & c.Row & ":F" & c.Row).Copy Cells(Target.Row, "B")
        End If
    End If
        
End Sub

.

 

[Emir Hüseyin Çoban]

. . .

Konuyu pekiştirmek için, linkteki mesajları inceleyiniz.
Sy Usubaykan' nın kodlamaları var. Faydalı olacaktır.

Tıkla ~ Makro İle Düşeyara

. . .

 

[abdullahss]

Hüseyin bey,Ömer bey teşekkürler ilginize artık birazda ben kurcalayarak bulurum yol gösterdiniz sağolun.

 

[abdullahss]

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a1:a15000]) Is Nothing Then
Set Sp = Sheets("Sipariş")
    
     If Target.Column = 1 Then
        If Target = "" Then Exit Sub
        Set c = Sp.[A:A].Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Sp.Range("B" & c.Row & ":k" & c.Row).Copy Cells(Target.Row, "B")
        End If
    End If
ElseIf Not Intersect(Target, [L:U]) Is Nothing Then
sat = Target.Row
Cells(sat, "v") = (Cells(sat, "L") + Cells(sat, "M") + Cells(sat, "N") + Cells(sat, "O") + Cells(sat, "P") + Cells(sat, "Q") + Cells(sat, "R") + Cells(sat, "S") + Cells(sat, "T") + Cells(sat, "u"))

End Sub

bu şekilde çözdüm ama bir yerde takıldım a sütununa deger verdigimde verileri alabiliyoruz a yı sildigimde verileri nasıl silerim.

 

[Ömer]

Bu şeklide deneyin.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [a1:a15000]) Is Nothing Then
Set Sp = Sheets("Sipariş")
    
     If Target.Column = 1 Then
        [COLOR=red]Range("B" & Target.Row & ":K" & Target.Row).ClearContents
[/COLOR]        If Target = "" Then Exit Sub
        Set c = Sp.[A:A].Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Sp.Range("B" & c.Row & ":k" & c.Row).Copy Cells(Target.Row, "B")
        End If
    End If
ElseIf Not Intersect(Target, [L:U]) Is Nothing Then
sat = Target.Row
Cells(sat, "v") = (Cells(sat, "L") + Cells(sat, "M") + Cells(sat, "N") + Cells(sat, "O") + Cells(sat, "P") + Cells(sat, "Q") + Cells(sat, "R") + Cells(sat, "S") + Cells(sat, "T") + Cells(sat, "u"))
End If
End Sub

.