Rakam aktarma

[karahan61]

Öncelikle Yeni yıl herkese sağlık ve mutluluklar getirmesi dileği ile Merhabalar

sizlerin yardımıyla bir çalışma hazırlamaktayım ve dosya ektedir. Görüleceği üzere haftanın günlerine göre o günlerin sutunlarında rakamlar var.

Sorunum: S10:BG80 aralığına ayın haftaları dağitılmış. bu aralıkta herhangi bir sutun veya sutunlar veya hücre/hücreler karaltıldığında mesela çif tıklandığında o hücrelere G10:K80 aralığındaki karşılığı olan rakamlar gelsin istiyorum
Yardım ederseniz sevinirim

 

[karahan61]

tıklamayla rakamların istenilen yere yazılması

Öncelikle Yeni yıl herkese sağlık ve mutluluklar getirmesi dileği ile Merhabalar

sizlerin yardımıyla bir çalışma hazırlamaktayım ve dosya ektedir. Görüleceği üzere haftanın günlerine göre o günlerin sutunlarında rakamlar var.

Sorunum: S10:BG80 aralığına ayın haftaları dağitılmış. bu aralıkta herhangi bir sutun veya sutunlar veya hücre/hücreler karaltıldığında mesela çif tıklandığında o hücrelere G10:K80 aralığındaki karşılığı olan rakamlar gelsin istiyorum
Yardım ederseniz sevinirim

 

[uzmanamele]

merhaba

syn karahan61, sorularınıza cevap alamadığınızda aynı soruya yeni konu açmayınız.
anlaşılmamış olabilir, gerekli açıklamaları yaparak ilk konunuz üzerinden devam ediniz.

 

[Korhan Ayhan]

Selamlar,

İlgili sayfanın kod bölümüne aşağıdaki kodu uygulayıp denermisiniz. Sayfa üzerinde seçim yaptığınızda kod otomatik çalışacaktır.

Option Explicit
 
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim HÜCRE As Range
    
    For Each HÜCRE In Selection
        If HÜCRE.Row > 9 Then
        If HÜCRE.Column > 18 Then
            Select Case Cells(8, HÜCRE.Column)
                Case Is = "Pazartesi"
                HÜCRE.Value = Cells(HÜCRE.Row, "G")
                Case Is = "Salı"
                HÜCRE.Value = Cells(HÜCRE.Row, "H")
                Case Is = "Çarşamba"
                HÜCRE.Value = Cells(HÜCRE.Row, "I")
                Case Is = "Perşembe"
                HÜCRE.Value = Cells(HÜCRE.Row, "J")
                Case Is = "Cuma"
                HÜCRE.Value = Cells(HÜCRE.Row, "K")
                Case Else
                HÜCRE.Value = Empty
            End Select
        End If
        End If
    Next
End Sub

 

[karahan61]

işte bu kadar teşekkürler

 

[karahan61]

sayın hocam çook güzel oldu ancak hücreye hemen yazıyor yön tuşuyla nereye gitsem yazıyor çift tıklamayla olmaz mı yada başka bir yol yinede emeğin için teşekkürler

 

[Korhan Ayhan]

Selamlar,

Çift tıklama ilede olabilir. Fakat tek tek hücrelere çift tıklamak zorunda kalacaksınız. İstiyorsanız bu şekilde düzenleyebilirim.

 

[karahan61]

selamlar zahmet olmazsa sevinirim

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = True
    
    If Target.Row > 9 Then
    If Target.Column > 18 Then
        Select Case Cells(8, Target.Column)
            Case Is = "Pazartesi"
            Target.Value = Cells(Target.Row, "G")
            Case Is = "Salı"
            Target.Value = Cells(Target.Row, "H")
            Case Is = "Çarşamba"
            Target.Value = Cells(Target.Row, "I")
            Case Is = "Perşembe"
            Target.Value = Cells(Target.Row, "J")
            Case Is = "Cuma"
            Target.Value = Cells(Target.Row, "K")
            Case Else
            Target.Value = Empty
        End Select
    End If
    End If
End Sub

 

[karahan61]

teşekkürler