Farklı Sayfadan Veri Alma

[1Al2Ver]

Merhaba,

2 farklı sayfam var, verilerin alınması istenen sayfada belli bir hücrenin üzerine fare ile gelindiğinde, verilerin alınacağı sayfadaki ilgili aralıktaki verilerin ilgili sütunda görüntülenmesini arzuluyorum,

Örneğin ;

B2 (CR) üzerine gelindiğinde SATIŞ sayfasındaki B2:B14,

L5 (Club5) üzerine gelindiğinde SATIŞ sayfasındaki J2:J14 aralığınıdaki verileri

1 sütun sağa ( CR için "C", Club5 için "M" sütunu ) getirebilsin,

Bu uygulamayı 12 ayın 5 farklı sütununda gerçekleştirmek istiyorum,

Teşekkür ederim,

 

[hamitcan]

Aşağıdaki kodu, (Yıllık Sıralama) sayfasının kod kısmına ekleyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$B$2" Then [d3:d14] = Sayfa6.[c3:c14].Value
    If Target.Address = "$L$2" Then [m3:m14] = Sayfa6.[j3:j14].Value
End Sub

 

[1Al2Ver]

Verilerin AÇIKLAMA KUTUSU'nda görülmesi

Aşağıdaki kodu, (Yıllık Sıralama) sayfasının kod kısmına ekleyin.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Address = "$B$2" Then [d3:d14] = Sayfa6.[c3:c14].Value
    If Target.Address = "$L$2" Then [m3:m14] = Sayfa6.[j3:j14].Value
End Sub

Sayın hamitcan merhaba,

İlginiz için teşekkür ederim,

Ancak istediğim bu değil,

Yeni bir başlık açarak (Farklı Sayfadan Resim Almak), isteğimi düzenleyerek, yeniledim,

http://www.excel.web.tr/showthread.php?t=83450

Teşekkür ederim.

 

[hamitcan]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Text = "CR" Or Target.Text = "Cross" Or Target.Text = "Club5" Then
    If Target.Column <= 4 Then c = Target.Column
    If Target.Column > 9 And Target.Column < 13 Then c = Target.Column - 2
    If Target.Column > 17 And Target.Column < 21 Then c = Target.Column - 2
    r = Target.Row + 1
    For i = r To r + 13
          t = t & Format(Sayfa6.Cells(i, c), "0.00") & Chr(10)
    Next
    With Target
        .ClearComments
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:=t
        .Comment.Shape.Select True
        Selection.ShapeRange.ScaleHeight 2.12, msoFalse, msoScaleFromTopLeft
    End With
    Else
    Cells.ClearComments
    End If
End Sub

 

[1Al2Ver]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Text = "CR" Or Target.Text = "Cross" Or Target.Text = "Club5" [COLOR="Red"]Or Target.Text = "Reject" Or Target.Text = "Return"[/COLOR] Then
    If Target.Column <= 4 Then c = Target.Column
    If Target.Column > 9 And Target.Column < 13 Then c = Target.Column - 2
    If Target.Column > 17 And Target.Column < 21 Then c = Target.Column - 2
    r = Target.Row + 1
    For i = r To r + 13
          t = t & Format(Sayfa6.Cells(i, c), "0.00") & Chr(10)
    Next
    With Target
        .ClearComments
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:=t
        .Comment.Shape.Select True
        Selection.ShapeRange.ScaleHeight 2.12, msoFalse, msoScaleFromTopLeft
    End With
    Else
    Cells.ClearComments
    End If
End Sub

Sayın hamitcan merhaba,

İlginiz için teşekkür ederim,

If Target.Text = "CR" Or Target.Text = "Cross" Or Target.Text = "Club5" Or Target.Text = "Reject" Or Target.Text = "Return" Then

Kırmızı ile yazılı olanların da koda ilave edilmesi gerekiyor, bu durumda kod'da yapılması gereken değişiklikleri (yada ilaveleri) de alabilirsem proje tamamlanacak,

Teşekkür ederim.

 

[hamitcan]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Text = "CR" Or _
       Target.Text = "Cross" Or _
       Target.Text = "Club5" Or _
       Target.Text = "Reject" Or _
       Target.Text = "Return" Then
    If Target.Column <= 6 Then c = Target.Column
    If Target.Column > 9 And Target.Column < 16 Then c = Target.Column - 2
    If Target.Column > 18 And Target.Column < 24 Then c = Target.Column - 2
    r = Target.Row + 1
    For i = r To r + 13
          t = t & Format(Sayfa6.Cells(i, c), "0.00") & Chr(10)
    Next
    With Target
        .ClearComments
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:=t
        .Comment.Shape.Select True
        Selection.ShapeRange.ScaleHeight 2.12, msoFalse, msoScaleFromTopLeft
    End With
    Else
    Cells.ClearComments
    End If
End Sub

 

[1Al2Ver]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Text = "CR" Or _
       Target.Text = "Cross" Or _
       Target.Text = "Club5" Or _
       Target.Text = "Reject" Or _
       Target.Text = "Return" Then
    If Target.Column <= 6 Then c = Target.Column
    If Target.Column > 9 And Target.Column < 16 Then c = Target.Column - 2
    If Target.Column > 18 And Target.Column < 24 Then c = Target.Column - 2
    r = Target.Row + 1
    For i = r To r + 13
          t = t & Format(Sayfa6.Cells(i, c), "0.00") & Chr(10)
    Next
    With Target
        .ClearComments
        .AddComment
        .Comment.Visible = True
        .Comment.Text Text:=t
        .Comment.Shape.Select True
        Selection.ShapeRange.ScaleHeight 2.12, msoFalse, msoScaleFromTopLeft
    End With
    Else
    Cells.ClearComments
    End If
End Sub

Sayın hamitcan merhaba,

Yardımlarınız için teşekkür ederim, aşağıdaki satırda ,

t = t & Format(Sayfa6.Cells(i, c), "0.00") & Chr(10)

Run-time error;'1004'
Application defined-or object-defined error mesajı aldım,

Aşağıdaki kod'daki rakamları değiştirerek denemeler yaptım, ancak sonuç değişmedi ,

If Target.Column > 9 And Target.Column < 16 Then c = Target.Column - 2
If Target.Column > 18 And Target.Column < 24 Then c = Target.Column - 2
r = Target.Row + 1
For i = r To r + 13

Saygılarımla.

 

[1Al2Ver]

Merhaba,

If Target.Column <= 6 Then c = Target.Column
If Target.Column > 9 And Target.Column < 15 Then c = Target.Column - 2
If Target.Column > 17 And Target.Column < 24 Then c = Target.Column - 4
r = Target.Row + 1
For i = r To r + 15

Kırmızı renkli sayılarda düzeltmeler yapılınca, düzeldi,

Yardımlarınız için tekrar teşekkür ederim.