Hey there!

It looks like you're enjoying Hesaptablosu - Akademik Excel Forumu but haven't created an account yet. Why not take a minute to register for your own free account now? As a member you get free access to all of our forums and posts plus the ability to post your own messages, communicate directly with other members and much more. Register now!

Already a member? Login at the top of this page to stop seeing this message.

Toplam 6 sonuçtan 1 ile 6 arasındakiler gösteriliyor.

Konu: Makro ile düsey arama

  1. #1
    Üye
    Üyelik tarihi
    Nov 2012
    Mesajlar
    42

    Makro ile düsey arama

    Günlük isimli dosyam var sayfa1 den sayfa2 düseyara ile verileri sicille göre cekiyorum ancak formul oldugu için sorunyasıyorum Makro ile bunu yapa bilirmiyiz tesekkurler
    dosyayı ekledim
    https://yadi.sk/i/Ks7-qHTl3KpRPE

  2. #2
    Kıdemli Üye
    Üyelik tarihi
    Jun 2010
    Nereden
    Erbaa
    Versiyon
    2010 TR
    Mesajlar
    1.015
    Mrb,
    Sayfa1 in adını veri,sayfa2 nin adını işlem olarak değiştirin.
    Aşağıdaki makro kodunu VBA sayfa1 yani veri sayfasının kod alanına yapıştırın.
    Veri sayfasında A sütununda istediğiniz personel numarasına çift tıklarsanız o satırı işlem sayfasına alt alta atar.
    Teknik olarak Inputbox ile de atılabilir ancak bütün sicil numaralarını ezbere bilmek veya bir listeden bakıp yazmak gerekir.
    Bu daha pratik diye düşünüyorum.
    Üstadlardan daha farklı bir çözüm üretilebilir.
    Kalın sağlıcakla.

    Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    On Error Resume Next
    Application.ScreenUpdating = False
    If Target = "" Then Exit Sub
    If Intersect(Target, [a:a]) Is Nothing Then Exit Sub
    Set s1 = Sheets("veri")
    Set s2 = Sheets("işlem")
    Son = s2.Cells(65536, 1).End(3).Row + 1
    s2.Range("a" & Son & "" & Son & "").Value = Range("a" & Target.Row & "" & Target.Row & "").Value
    Columns("C:E").Select
    Selection.EntireColumn.Hidden = True
    Range("A1").Select
    Target.Offset(1, 0).Select

    Set s1 = Nothing
    Set s2 = Nothing
    Application.ScreenUpdating = True
    End Sub

  3. #3
    Kıdemli Üye
    Üyelik tarihi
    Dec 2009
    Nereden
    İstanbul
    Versiyon
    Excel 2003 - 2007 TR
    Mesajlar
    414
    Alternatif,

    Kod:
    Option Explicit
    Sub dusey_ara()
    Dim a(), b(), c(), e(), d As Object
    Dim S1  As Worksheet, s2 As Worksheet
    Dim i As Long, y As Byte, Say As Long
    
    
    Set S1 = Sheets("Sayfa1")
    Set s2 = Sheets("Sayfa2")
    Set d = CreateObject("scripting.dictionary")
    
    
    a = S1.Range("A2:P" & S1.Range("A" & Rows.Count).End(3).Row)
    ReDim b(1 To UBound(a), 1 To 12)
    For i = 1 To UBound(a)
        If Not d.exists(a(i, 1)) Then
            Say = Say + 1
            d(CStr(a(i, 1))) = Say
            b(Say, 1) = a(i, 2)
            b(Say, 2) = a(i, 6)
            b(Say, 3) = a(i, 7)
            b(Say, 4) = a(i, 8)
            b(Say, 5) = a(i, 9)
            b(Say, 6) = a(i, 10)
            b(Say, 7) = a(i, 12)
            b(Say, 8) = a(i, 11)
            b(Say, 9) = a(i, 13)
            b(Say, 10) = a(i, 14)
            b(Say, 11) = a(i, 15)
            b(Say, 12) = a(i, 16)
        End If
    Next i
    
    
    On Error Resume Next
    Say = 0
    c = s2.Range("A2:A" & s2.Range("A" & Rows.Count).End(3).Row)
    ReDim e(1 To UBound(c), 1 To 12)
    For i = 1 To UBound(c)
        Say = Say + 1
        For y = 1 To 12
            e(Say, y) = b(d(CStr(c(i, 1))), y)
        Next y
    Next i
    
    
    s2.Range("B2:M" & Rows.Count).ClearContents
    If Say > 0 Then
        s2.[B2].Resize(Say, 12) = e
    End If
    MsgBox "İşlem tamam.", vbInformation
    End Sub

  4. #4
    Kıdemli Üye
    Üyelik tarihi
    Jun 2010
    Nereden
    Erbaa
    Versiyon
    2010 TR
    Mesajlar
    1.015
    Merhaba Üstadım,
    Elinize gözünüze sağlık..
    Problem sahibi enes9 kardeşimiz 3 gündür kayıp oldu.( Böyle soru sorup kayıp olanlar beni üzüyor.)
    Sizin makroyu denedim. Tümünü birden ikinci sayfaya aktarıyor.
    Ancak; Benim anladığım kadarıyla Sayfa1 deki tüm verileri değil de istenilen veriyi Sayfa2 ye alt alta çekmek istiyor.
    InputBox ile Sicil nosunu girdiğimiz personelin bilgisini ikinci sayfaya alt alta aktarmak istesek nasıl olur acaba?
    Saygılarımla..
    Kalın sağlıcakla.
    Konu behcet tarafından (09.07.2017 Saat 20:51 ) değiştirilmiştir.

  5. #5
    Üye
    Üyelik tarihi
    Nov 2012
    Mesajlar
    42
    Allah razı olsun sizlerden istediğim gib olmuş tesekkur ederim

  6. #6
    Kıdemli Üye
    Üyelik tarihi
    Apr 2004
    Mesajlar
    891
    Alıntı enes39 Nickli Üyeden Alıntı Mesajı göster
    formul oldugu için sorun yasıyorum
    Merhaba
    Formül ile ilgili nasıl bir sorun yaşıyorsunuz?
    Bu tür sorunlara makro ile çözüm aranmasına herzaman karşı çıkmışımdır.

Konu Bilgisi

Users Browsing this Thread

Şu anda 1 üyemiz bu konuya göz atıyor. (0 kayıtlı üye ve 1 misafir.)

Yetkileriniz

  • Konu Acma Yetkiniz Yok
  • Cevap Yazma Yetkiniz Yok
  • Eklenti Yükleme Yetkiniz Yok
  • Mesajınızı Değiştirme Yetkiniz Yok
  •