AccessTr.neT

Bul · 20/11/2023, 18:32

Dosyayı deneyin B4:B10 aralığından seçim yapın Kullandığım sayfa şekli sayfasında.

PHP Kod:

Sub Aktar()
    Dim syfKimya As Worksheet, bul, ara As Range, say As Integer, i As Integer
    Dim bul2  As Range
    
    say = 7
    With ThisWorkbook.Worksheets("Kimya")
        For i = 4 To 10
            bul = Application.Match(Cells(i, "B").Value2, .Range("C:C"), 0)
            If Not IsError(bul) Then
                For Each ara In .Range("I" & bul & ":BR" & bul)
                    If Len(Trim(ara.Value)) > 0 Then
                        If Trim(Cells(3, say).Value) = "" Then
                            Set bul2 = Range("G3:T3").Find(.Cells(2, ara.Column).Value2, , , 1)
                            If Not bul2 Is Nothing Then
                                Cells(3, bul2.Column).Value = .Cells(2, ara.Column).Value
                            Else
                                Cells(3, say).Value = .Cells(2, ara.Column).Value
                                say = say + 1
                            End If
                            Set bul2 = Nothing
                        End If
                    End If
                Next
            End If
        Next
    End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, [B4:B10]) Is Nothing Then
        Range("G3:T3").Value = ""
        Aktar
    End If
End Sub

Bul · 20/11/2023, 18:55

Sayın feraz elinize sağlık tam istediğim şekilde olmuş. çokkk teşekkürler. size bir şey daha sorsam çok mu olur acaba. sayfa listesi sayfası var görmüşsünüzdür. oraya bir kodla çalışma sayfalarını listeliyorum. yeni sayfa eklendiğinde güncelle butonuyla sayfayı güncelliyorum. listedeki isimlere çift tıklandığında da ilgili sayfaya gidebiliyorum. bu isim listelerinin olduğu sayfada sayfa ismine nasıl bir kod yazılarak ilgili sayfada ki garanti edilen içerik kısmı yansıtılabilir. yanı her isme tıklandığında o sayfadaki garanti edilen içerik görünsün.

saygılar.

Bul · 20/11/2023, 19:27

Rica ederim.Kodu böyle güncelleyin.

PHP Kod:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim ws As Worksheet

    ' Eðer týklanan hücre A sütunundaysa
    If Target.Column = 1 Then
        ' Belirtilen sayfa adýna sahip bir sayfa var mý kontrol et
        On Error Resume Next
        Set ws = Sheets(Target.Value)
        On Error GoTo 0

        ' Sayfa varsa ilgili sayfaya git
        If Not ws Is Nothing Then ws.Select
    End If
    
    If Target.Column = 2 Then
        ' Belirtilen sayfa adýna sahip bir sayfa var mý kontrol et
        On Error Resume Next
        Set ws = Sheets(Range("A" & Target.Row).Value)
        On Error GoTo 0
        
        Dim bul As Range
        Set bul = ws.Cells.Find(Target.Value2, , , , 1)
        
        If Not bul Is Nothing Then
            If Not ws Is Nothing Then ws.Select
            bul.Activate
        End If
        
        ' Sayfa varsa ilgili sayfaya git
        Set bul = Nothing
    End If
End Sub

Bul · 20/11/2023, 19:47

Anladığım kadarıyla b sütununa tıklayınca soldaki sayfa isminde tıklanan varsa oraya gider.Dosyanızda galiba 2 sayfada vardı.Birde önceki kodda g3:t3 ve ı2:br2 olarak ve b4:b10 ları sabit ywpmıştım bunları kodla ayarlarsınız son sütun va satır bularak örneğin.

Bul · 20/11/2023, 19:57

(20/11/2023, 19:47)feraz yazdı: Anladığım kadarıyla b sütununa tıklayınca soldaki sayfa isminde tıklanan varsa oraya gider.Dosyanızda galiba 2 sayfada vardı.Birde önceki kodda g3:t3 ve ı2:br2 olarak ve b4:b10 ları sabit ywpmıştım bunları kodla ayarlarsınız son sütun va satır bularak örneğin.

sayın feraz: aslında normal çalışma da çok sayfa var. bunların hepsini Sayfa listesi çalışma sayfasında listeliyorum. Sayfa listesi sayfasında listedeki isimlere çift tıklamada ilgili sayfaya gidebiliyordum zaten. kodunu yazdığınız sayfada alt kısımda garanti edilen içerik diye bir kısım var. bu kısmı Sayfa listesinde görmek mümkün mü. yani her ismin karşısında bir butonla yada başka bir yöntemler.

[Resim: do.php?img=15470]

Bul · 20/11/2023, 22:24

Kod altta abey.Sorun değil.Başka sorunuz olursa yeni konu açın.Kolay gelsin.
Column=2 olan kısımdaki kodlar ayarlandı.

Kod:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim ws As Worksheet



    ' E?er t?klanan hücre A sütunundaysa

    If Target.Column = 1 Then

        ' Belirtilen sayfa ad?na sahip bir sayfa var m? kontrol et

        On Error Resume Next

        Set ws = Sheets(Target.Value)

        On Error GoTo 0



        ' Sayfa varsa ilgili sayfaya git

        If Not ws Is Nothing Then ws.Select

    End If

    

    If Target.Column = 2 Then

        Dim son As Integer, bul As Range

        On Error Resume Next

        Set ws = Sheets(Range("A" & Target.Row).Value)

        On Error GoTo 0

        Range("D2:F" & Rows.Count).Borders.LineStyle = xlNone

        Range("D2:F" & Cells(Rows.Count, "D").End(3).Row + 3).ClearContents



        Set bul = ws.Cells.Find(Target.Value2, , , , 1)

        

        If Not bul Is Nothing Then

            If WorksheetFunction.CountA(ws.Range(ws.Cells(bul.Row, bul.Column), ws.Cells(Rows.Count, bul.Column))) = 0 Then GoTo SonSub

            son = ws.Cells(Rows.Count, bul.Column).End(3).Row

            ws.Range(bul.Address, ws.Cells(son, bul.Column + 2)).Copy

            Range("D2").PasteSpecial xlPasteValuesAndNumberFormats

            Range("D3", Cells(Cells(Rows.Count, "D").End(3).Row, "F")).Borders.LineStyle = 1

            Application.CutCopyMode = False

            Columns("D:F").Columns.AutoFit

            Range("D1").Select

        End If

SonSub:

        Set bul = Nothing

    End If

End Sub

AccessTr.neT

Reçete Hazırlama

Reçete Hazırlama

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Giriş yap

Hesap oluştur

Konu Linkleri