Sayfaların adlarını yerleştirmesi hk.

[1903emre34@gmail.com]

Merhaba,

Ana hesap türleri, hesap, hesap dışı, hesap gelir sayfalarında yer alıyor, benim istediğim yanlarına hangi sayfalarda yer alıyorsa onun yanına yerleşmesi için nasıl kod oluşturabiliriz.

 

[bmutlu966]

Kolay gelsin.

 

[1903emre34@gmail.com]

İlginiz için teşekkürler, sayfa aktarma olmayacak, sayfadaki adlarının yanına yerleşmesi şeklinde istemiştim.

 

[bmutlu966]

Aynı şey değil mi? Siz datanıza girdiğiniz bilgileri K kolununda belirtilen sayfalara aktarmasını istemiyor musunuz. Dosya bu işi yapıyor. Tam ne istediğinizi anlamadım. Yoksa tam tersi sayfalardaki bilgilerin DATA sayfasına mı toplanmasını istiyorsunuz.

 

[YUSUF44]

Aşağıdaki makroyu deneyin:

Sub aktar()
Set s1 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, "D").End(3).Row
For i = 2 To son
    hesap = "yok"
    For sayfa = 1 To Sheets.Count
        If Sheets(sayfa).Name <> s1.Name Then
            sons = Sheets(sayfa).Cells(Rows.Count, "D").End(3).Row
            If WorksheetFunction.CountIf(Sheets(sayfa).Range("D1:D" & sons), s1.Cells(i, "D")) > 0 Then
                hesap = "var"
                s1.Cells(i, "K") = Sheets(sayfa).Name
                s1.Range("A" & i & ":K" & i).Interior.Color = xlNone
                sayfa = Sheets.Count
            End If
        End If
    Next
    If hesap = "yok" Then
        s1.Cells(i, "K") = "Ana Hesap Türü Hatalı"
        s1.Range("A" & i & ":K" & i).Interior.Color = vbRed
    End If
Next         
End Sub

 

[bmutlu966]

Bu şekilde mi istiyordunuz?

 

[1903emre34@gmail.com]

Teşekkürler, Yusuf bey

 

[veyselemre]

Sub test()

    With CreateObject("Scripting.Dictionary")
        For Each syf In Array("HESAP ", "HESAP DIŞI ", "HESAP GELİR ")
            Set s1 = Sheets(syf)
            son = s1.Cells(Rows.Count, "C").End(xlUp).Row
            For i = 4 To son
                .Item(Trim(s1.Cells(i, 3))) = s1.Name
            Next i
        Next syf

        Sheets("Sayfa1").Select
        For i = 2 To Cells(Rows.Count, "C").End(3).Row
            If .exists(Trim(Cells(i, 3))) Then Cells(i, 11) = .Item(Trim(Cells(i, 3)))
        Next i
    End With

End Sub

 

[1903emre34@gmail.com]

Aşağıdaki makroyu deneyin:

Sub aktar()
Set s1 = Sheets("Sayfa1")
son = s1.Cells(Rows.Count, "D").End(3).Row
For i = 2 To son
    hesap = "yok"
    For sayfa = 1 To Sheets.Count
        If Sheets(sayfa).Name <> s1.Name Then
            sons = Sheets(sayfa).Cells(Rows.Count, "D").End(3).Row
            If WorksheetFunction.CountIf(Sheets(sayfa).Range("D1:D" & sons), s1.Cells(i, "D")) > 0 Then
                hesap = "var"
                s1.Cells(i, "K") = Sheets(sayfa).Name
                s1.Range("A" & i & ":K" & i).Interior.Color = xlNone
                sayfa = Sheets.Count
            End If
        End If
    Next
    If hesap = "yok" Then
        s1.Cells(i, "K") = "Ana Hesap Türü Hatalı"
        s1.Range("A" & i & ":K" & i).Interior.Color = vbRed
    End If
Next        
End Sub

Yusuf bey,

Hesap sayfasında sarı ile boyanmış hücreler, Sayfa1 sayfasında "HESAP" kelimesi yerine "Ana Hesap Türü Hatalı" yazısı gelmektedir. size zahmet bakabilir misiniz.

 

[YUSUF44]

HESAP sayfasında tanımlar diğer sayfaların aksine C sütununda yer alıyor. Örnek dosyanızda D sütunundaydı ama şimdiki dosyanızda C sütununa almışsınız. Pratik olması için araya bir sütun ekleyip gizleyerek çözebilirsiniz.