Düşey ara ile ilgili makro

[OZCANLOK]

Formda aradım fakat bulamadım belki makro
örnek tabloda gerekli açıklamayı yaptım

Yardımdımcı olusanız sevinirim

Şimdiden teşekkürler

 

[Orion1]

Merhaba.
Ekteki dosyayı inceleyiniz.
Düşeyara formülü ile yapıldı.

 

[AS3434]

Sayın OZCANLOK

Bence Makroya gerek kalmadan aşağıdaki şekilde yapın.

Listedata Sayfasında C6 hücresine =giriş!C8 yazın aşağıya ve sağa kopyalayın.

 

[OZCANLOK]

Tablo çok büyük olduğu için

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

yapmam lazım

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu Giriş isimli sayfanızın kod bölümüne uygulayıp denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    Set SLD = Sheets("ListeData")
    Set SG = Sheets("Giriş")
    If Intersect(Target, [C8:J65536]) Is Nothing Then Exit Sub
    If WorksheetFunction.CountIf(SLD.[B:B], Cells(Target.Row, 2)) > 0 Then
    SATIR = SLD.[B:B].Find(Cells(Target.Row, 2)).Row
    SLD.Cells(SATIR, Target.Column) = Target
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    Set SLD = Sheets("ListeData")
    Set SG = Sheets("Giriş")
    If Intersect(Target, [B8:B65536]) Is Nothing Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    For X = 3 To 10
    Cells(Target.Row, X) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], X - 1, 0)
    Next
End Sub

 

[Recep İpek]

Aşağıdaki kodları kullanabilirsiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [b7:j7]) Is Nothing Then Exit Sub
Set s1 = Sheets("ListeData")
Set s2 = Sheets("Giriş")

For i = 2 To 10
    If s1.Cells(5, i).Value = Target.Value Then
        s2.Range(Cells(8, Target.Column), Cells(50, Target.Column)).ClearContents
        For j = 6 To s1.Cells(65536, i).End(3).Row
            s2.Cells(j + 2, Target.Column).Value = s1.Cells(j, i).Value
        Next j
    End If
Next i

Set s1 = Nothing
Set s2 = Nothing

End Sub

 

[OZCANLOK]

sn COST_CONTROL tablo tam istediğim gibi fakat

giriş sayfasındaki kolonlarla liste data sayfasındaki kolonlar

aynı sırada değil buna nasıl çözebilirim

yani girişte c kolunun

liste datadaki e kolonuna gibi

ilginiz için çok teşekkürler

 

[Korhan Ayhan]

Selamlar,

Eğer örnek dosyanızı belirttiğiniz şekilde ekleseydiniz çözümüde ona göre alacaktınız. Lütfen orjinal dosyanızın benzerini eklermisiniz.

 

[OZCANLOK]

Sn cost control tabloda renklendirdiğim kolonlar biribirine

denk gelecek şekilde

teşekkürler

 

[OZCANLOK]

tablo ekte

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo SON
    If Target.Address Like "*" & ":" & "*" Then Exit Sub
    Set SLD = Sheets("ListeData")
    Set SG = Sheets("Giriş")
    If Intersect(Target, [B8:B65536,C8:J65536]) Is Nothing Then Exit Sub
    If WorksheetFunction.CountIf(SLD.[B:B], Cells(Target.Row, 2)) > 0 Then
    SATIR = SLD.[B:B].Find(Cells(Target.Row, 2)).Row
    If Target.Column = 3 Then
    SLD.Cells(SATIR, 5) = Target
    ElseIf Target.Column = 4 Then
    SLD.Cells(SATIR, 7) = Target
    ElseIf Target.Column = 5 Then
    SLD.Cells(SATIR, 6) = Target
    ElseIf Target.Column = 6 Then
    SLD.Cells(SATIR, 3) = Target
    ElseIf Target.Column = 7 Then
    SLD.Cells(SATIR, 8) = Target
    ElseIf Target.Column = 8 Then
    SLD.Cells(SATIR, 4) = Target
    ElseIf Target.Column = 9 Then
    SLD.Cells(SATIR, 9) = Target
    ElseIf Target.Column = 10 Then
    SLD.Cells(SATIR, 10) = Target
    End If
    End If
    If Target.Column = 2 And Not IsEmpty(Target) Then
    Cells(Target.Row, 3) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 4, 0)
    Cells(Target.Row, 4) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 6, 0)
    Cells(Target.Row, 5) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 5, 0)
    Cells(Target.Row, 6) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 2, 0)
    Cells(Target.Row, 7) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 7, 0)
    Cells(Target.Row, 8) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 3, 0)
    Cells(Target.Row, 9) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 8, 0)
    Cells(Target.Row, 10) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 9, 0)
    End If
    Exit Sub
SON:
    Range(Cells(Target.Row, 3), Cells(Target.Row, 10)) = ""
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo SON
    If Target.Address Like "*" & ":" & "*" Then Exit Sub
    Set SLD = Sheets("ListeData")
    Set SG = Sheets("Giriş")
    If Intersect(Target, [B8:B65536]) Is Nothing Then Exit Sub
    If IsEmpty(Target) Then Exit Sub
    Cells(Target.Row, 3) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 4, 0)
    Cells(Target.Row, 4) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 6, 0)
    Cells(Target.Row, 5) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 5, 0)
    Cells(Target.Row, 6) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 2, 0)
    Cells(Target.Row, 7) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 7, 0)
    Cells(Target.Row, 8) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 3, 0)
    Cells(Target.Row, 9) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 8, 0)
    Cells(Target.Row, 10) = WorksheetFunction.VLookup(Target, SLD.[B5:J65536], 9, 0)
    Exit Sub
SON:
    Range(Cells(Target.Row, 3), Cells(Target.Row, 10)) = ""
End Sub

 

[OZCANLOK]

sn cost tam istediğim gibi olmuş elinize ve bilginize sağlık

çok teşekkürler