• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

sayfalar arası değer ataması

O

opossum

Katılım
15 Eylül 2008
Mesajlar
132
Excel Vers. ve Dili
office 2016
iyi bayramlar benim yapmak istediğim bir çalışma var çalıştığım belgede sayfa 1 deki B3 hücresine "1" değerini girince B4 B5 B6 hücrelerindeki değerler sayfa 2 de istediğim hücrelere otomatik atsın. B3 hücresine "2" değerini girince B4 B5 B6 hücrelerindeki değerler sayfa 3 e istediğim hücrelere otomatik atsın.
 

Ekli dosyalar

  • 1.xls
    1.xls
    26 KB · Görüntüleme: 12
Selamlar,

Sayfa2 B3 hücresine aşağıdaki formülü uygulayıp yana doğru sürükleyin.

Kod: 
=EĞER(Sayfa1!$B3=1;Sayfa1!B3;"")

Sayfa3 B3 hücresine aşağıdaki formülü uygulayıp yana doğru sürükleyin.

Kod: 
=EĞER(Sayfa1!$B3=2;Sayfa1!B3;"")

Eğer amacınız belli kriterlere göre verileri ayrı sayfalara listelemekse bu şekilde bir formül kullanırsanız arada boş satırlar oluşacaktır. Bu durumda alternatif çözümler üretilebilir.
 
Korhan Ayhan' Alıntı:
Selamlar,

Sayfa2 B3 hücresine aşağıdaki formülü uygulayıp yana doğru sürükleyin.

Kod: 
=EĞER(Sayfa1!$B3=1;Sayfa1!B3;"")

Sayfa3 B3 hücresine aşağıdaki formülü uygulayıp yana doğru sürükleyin.

Kod: 
=EĞER(Sayfa1!$B3=2;Sayfa1!B3;"")

Eğer amacınız belli kriterlere göre verileri ayrı sayfalara listelemekse bu şekilde bir formül kullanırsanız arada boş satırlar oluşacaktır. Bu durumda alternatif çözümler üretilebilir.
Genişletmek için tıkla ...


yazdığın formül çalışıyor yalnız çalışmam düşündüğüm gibi olmadı ekte yeni verdiğim dosyada nasıl bir çalışma yapabiliriz teşekkürler iyi bayramlar
 

Ekli dosyalar

  • 1.xls
    1.xls
    30 KB · Görüntüleme: 9
İstediğiniz bumudur.:cool:
Ekli dosyayı inceleyiniz.:cool:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B65536]) Is Nothing Then Exit Sub
On Error Resume Next
sat = Sheets("Sayfa" & Target.Value + 1).Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Sayfa" & Target.Value + 1 & " satır doldu." & vbLf _
    & "Bu kayıt kaydedilmedi.", vbCritical, "UYARI"
    Exit Sub
End If
Sheets("Sayfa" & Target.Value + 1).Range("A" & sat & ":E" & sat).Value = _
Range("A" & Target.Row & ":E" & Target.Row).Value
End Sub
 

Ekli dosyalar

Evren Gizlen' Alıntı:
İstediğiniz bumudur.:cool:
Ekli dosyayı inceleyiniz.:cool:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B65536]) Is Nothing Then Exit Sub
On Error Resume Next
sat = Sheets("Sayfa" & Target.Value + 1).Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Sayfa" & Target.Value + 1 & " satır doldu." & vbLf _
    & "Bu kayıt kaydedilmedi.", vbCritical, "UYARI"
    Exit Sub
End If
Sheets("Sayfa" & Target.Value + 1).Range("A" & sat & ":E" & sat).Value = _
Range("A" & Target.Row & ":E" & Target.Row).Value
End Sub
[/QUOT
verdiğin kod işime yaradı fakat bir sıkıntım var B hücresinde var olan değeri değiştirdiğimde değeri yeni sayfaya atıyor ama geçerliliğini yitiren değer aynen kalıyor silinmiyor. yani istediğim B hücresimdeki değere göre veriler atansın B hücresinde değişiklik yaptığım zaman eski atanan veriler silinsin yeni değere göre güncellensin
Genişletmek için tıkla ...
 
opossum' Alıntı:
Evren Gizlen' Alıntı:
İstediğiniz bumudur.:cool:
Ekli dosyayı inceleyiniz.:cool:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B3:B65536]) Is Nothing Then Exit Sub
On Error Resume Next
sat = Sheets("Sayfa" & Target.Value + 1).Cells(65536, "B").End(xlUp).Row + 1
If sat >= 65533 Then
    MsgBox "Sayfa" & Target.Value + 1 & " satır doldu." & vbLf _
    & "Bu kayıt kaydedilmedi.", vbCritical, "UYARI"
    Exit Sub
End If
Sheets("Sayfa" & Target.Value + 1).Range("A" & sat & ":E" & sat).Value = _
Range("A" & Target.Row & ":E" & Target.Row).Value
End Sub
[/QUOT
verdiğin kod işime yaradı fakat bir sıkıntım var B hücresinde var olan değeri değiştirdiğimde değeri yeni sayfaya atıyor ama geçerliliğini yitiren değer aynen kalıyor silinmiyor. yani istediğim B hücresimdeki değere göre veriler atansın B hücresinde değişiklik yaptığım zaman eski atanan veriler silinsin yeni değere göre güncellensin
Genişletmek için tıkla ...

Bulunduğu sayfada o isimleri ID nolarına göre buluyor.Ve güncelliyor.Yoksa yeni kayıt ekliyor.Ve otomatik yeni ıd ekliyor a sütununa
Dosyanız ektedir.:cool:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim k As Range, adr As String
If Intersect(Target, [B3:C65536]) Is Nothing Then Exit Sub
On Error Resume Next
If Target.Column = 2 Then
    If Target.Offset(0, -1).Value = "" Then
        Range("I1").Value = Range("I1").Value + 1
        Target.Offset(0, -1).Value = Range("I1").Value
    End If
Else
If Target.Offset(0, -1).Value = "" Then
    MsgBox "Kayıt yapabilmek için B sütunundaki satıra bir ad giriniz." & _
    vbLf & "Kayıt girilmedi.", vbCritical, "UYARI"
    Target.Offset(0, -1).Select
    Exit Sub
End If

Set k = Sheets("Sayfa" & Target.Value + 1).Range("A:A").Find(Target.Offset(0, -2).Value _
, , xlValues, xlWhole)
If Not k Is Nothing Then
    adr = k.Address
    Do
        Range("A" & Target.Row & ":F" & Target.Row).Copy _
        Sheets("Sayfa" & Target.Value + 1).Range("A" & k.Row)
        Set k = Sheets("Sayfa" & Target.Value + 1).Range("A:A").FindNext(k)
    Loop While Not k Is Nothing And k.Address <> adr
    Else
    sat = Sheets("Sayfa" & Target.Value + 1).Cells(65536, "B").End(xlUp).Row + 1
    If sat >= 65533 Then
        MsgBox "Sayfa" & Target.Value + 1 & " satır doldu." & vbLf _
        & "Bu kayıt kaydedilmedi.", vbCritical, "UYARI"
        Exit Sub
    End If
    Sheets("Sayfa" & Target.Value + 1).Range("A" & sat & ":F" & sat).Value = _
    Range("A" & Target.Row & ":F" & Target.Row).Value
End If
End If
End Sub
Genişletmek için tıkla ...
 

Ekli dosyalar

YARDIMLARIN İÇİN TEŞEKKÜR EDERİM EN SON EKLİ DOSYADA ÖRNEĞİN C3 DEĞERİNİ 1 VERİYORUM SAYFA 1e VERİLER ATANIYOR AMA BU 1 DEĞERİNİ SİLİP 2 YAZDIĞIMDA YENİ DEĞERLER SAYFA 2YE YAZIYOR AMA SAYFA 1 DEKİ DEĞERLER SİLİNMİYOR BEN SİLİNSİN İSTİYORUM TEŞEKKÜRLER
 
opossum' Alıntı:
YARDIMLARIN İÇİN TEŞEKKÜR EDERİM EN SON EKLİ DOSYADA ÖRNEĞİN C3 DEĞERİNİ 1 VERİYORUM SAYFA 1e VERİLER ATANIYOR AMA BU 1 DEĞERİNİ SİLİP 2 YAZDIĞIMDA YENİ DEĞERLER SAYFA 2YE YAZIYOR AMA SAYFA 1 DEKİ DEĞERLER SİLİNMİYOR BEN SİLİNSİN İSTİYORUM TEŞEKKÜRLER
Genişletmek için tıkla ...
Ayni konu için birden fazla konu açmayınız.
Mesajlarınızı Büyük harflerle yazmayınız.:cool:
 
Selamlar,

Son eklediğiniz dosyaya göre aşağıdaki kodu denermisiniz.


Sayfa1 isimli sayfanızın kod bölümüne uygulayınız.

Kod: 
Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SAYFA As String, SATIR As Long, BUL As Range
 
    If Intersect(Target, [D4:I65536]) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    SAYFA = Split(Target.Address, "$")(1)
    If Target = 1 Then
    With Sheets(SAYFA)
        Set BUL = .Range("B:B").Find(Cells(Target.Row, 2), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        .Cells(BUL.Row, 2) = Cells(Target.Row, 2)
        .Range("C" & BUL.Row & ":IO" & BUL.Row).Value = Range("J" & Target.Row & ":IV" & Target.Row).Value
        Else
        SATIR = IIf(.Range("B1") = Empty, 1, .Range("B65536").End(3).Row + 1)
        .Cells(SATIR, 2) = Cells(Target.Row, 2)
        .Range("C" & SATIR & ":IO" & SATIR).Value = Range("J" & Target.Row & ":IV" & Target.Row).Value
        End If
    End With
 
    ElseIf Target = Empty Then
 
    With Sheets(SAYFA)
        Set BUL = .Range("B:B").Find(Cells(Target.Row, 2), LookAt:=xlWhole)
        If Not BUL Is Nothing Then
        .Rows(BUL.Row).Delete
        End If
        Set BUL = Nothing
    End With
    End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst