Makroyu Birleştirilmiş Hücrede Çalıştırma

ormann · 28 Kasım 2019

İyi günler; ekli dosyada ALİ sayfasında C4 hücresine ALİ sayfasında J12:J67 hücre aralığındaki herhangi bir harfi girip Enter tuşuna bastığımda Userformda ilgili veriler süzülüyor.Benim yapmak istediğim aynı işlemi VERİ sayfasında birleştirilmiş D5

23 hücresi ile M7 hücresindede çalışması .Bu konuda yardımıcı olur musunuz ?.Saygılar

İndir yardım

Dosyayı indir yardım

dosya.co

Ömer · 28 Kasım 2019

Merhaba,

Bu Çalışma Kitabındaki kodları silerek aşağıdakileri yapıştırın:

Kod:

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    Dim S1 As Worksheet, BUL As Range
   
    If Intersect(Target, Sheets("VERİ").Range("M7")) Is Nothing Then Exit Sub
   
    Cancel = True
   
    If Target <> "" Then
        Application.EnableEvents = False
        Set S1 = Sheets("VERİ")
        If WorksheetFunction.CountIf(S1.Range("D5:D" & Rows.Count), "*" & Target & "*") = 1 Then
            Set BUL = S1.Range("D5:G" & Rows.Count).Find(Target)
            If Not BUL Is Nothing Then
                Target = BUL.Value
            End If
        Else
            ANIMSATICI
        End If
        Set S1 = Nothing
        Set BUL = Nothing
    Else
        ANIMSATICI
    End If
   
Son:
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim S1 As Worksheet, BUL As Range
   
    If Intersect(Target, Sheets("VERİ").Range("M7")) Is Nothing Then Exit Sub
   
    On Error GoTo Son
   
    If Target.Cells.Count > 1 Then Exit Sub

    If Target <> "" Then
        Application.EnableEvents = False
        Target.Select
        Set S1 = Sheets("VERİ")
        If WorksheetFunction.CountIf(S1.Range("D5:D" & Rows.Count), "*" & Target & "*") = 1 Then
            Set BUL = S1.Range("D5:G" & Rows.Count).Find(Target)
            If Not BUL Is Nothing Then
                Target = BUL.Value
            End If
        Else
            ANIMSATICI
        End If
        Set S1 = Nothing
        Set BUL = Nothing
    End If
   
Son:
    Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    If Application.CutCopyMode = xlCopy Or Application.CutCopyMode = xlCut Then Exit Sub
    If Val(Application.Version) < 12 Then
        ShowAtCell_1
    Else
        ShowAtCell_2
    End If
End Sub

UserfForm1 deki kodları silerek aşağıdakileri yapıştırın.

Kod:

Dim S1 As Worksheet
Dim BUL As Range, ADRES As String

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Selection.Value = ListBox1.Value
    Unload Me
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyEscape Then Unload Me
    If KeyCode = 13 And ListBox1.ListIndex >= 0 Then
        Selection.Value = ListBox1.Value
        Unload Me
    End If
End Sub

Private Sub TextBox1_Change()
    Dim X As Long, Say As Long
    Dim Aranan_Veri As String
    Dim Sorgulanan_Veri As String
   
    If TextBox1 <> "" Then
        Aranan_Veri = Evaluate("=UPPER(""" & TextBox1.Text & """)")
       
        ReDim Data(1 To 1)
       
        For X = 5 To S1.Cells(Rows.Count, 4).End(3).Row
            Sorgulanan_Veri = Evaluate("=UPPER(""" & S1.Cells(X, 4).Text & """)")
           
            If InStr(1, Sorgulanan_Veri, Aranan_Veri, vbTextCompare) > 0 Then
                Say = Say + 1
                ReDim Preserve Data(1 To Say)
                Data(Say) = S1.Cells(X, 4)
            End If
        Next
       
        ListBox1.RowSource = ""
        ListBox1.Clear
        If Say > 0 Then ListBox1.List = Data
        Label4.Caption = " Listelenen Kayıt : " & ListBox1.ListCount
    Else
        ListBox1.RowSource = "'VERİ'!D5:D" & S1.Cells(Rows.Count, 4).End(3).Row
        Label4.Caption = " Listelenen Kayıt : " & ListBox1.ListCount
    End If
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyEscape Then Unload Me
End Sub

Private Sub UserForm_Activate()
    Dim Satır As Long
    Dim Konum As Pointapi
    GetCursorPos Konum
   
    With Me
        .StartUpPosition = 0
        .Left = Konum.X * 0.75 - Fark_Sütun
        .Top = Konum.Y * 0.75 - Fark_Satır
    End With
   
    Set S1 = Sheets("VERİ")

    If ActiveCell = "" Or Selection.Cells.Count > 1 Then
        ListBox1.RowSource = "'VERİ'!D5:D" & S1.Cells(Rows.Count, 4).End(3).Row
        Label4.Caption = " Listelenen Kayıt : " & ListBox1.ListCount
        Exit Sub
    End If
   
    Set BUL = S1.Range("D5:G" & Rows.Count).Find(ActiveCell.Value, , , xlPart)
    If Not BUL Is Nothing Then
        ADRES = BUL.Address
        Do
            ListBox1.AddItem
            ListBox1.List(Satır, 0) = BUL.Offset(0, 0).Value
            Satır = Satır + 1
            Set BUL = S1.Range("D5:G" & Rows.Count).FindNext(BUL)
        Loop While Not BUL Is Nothing And BUL.Address <> ADRES
    End If
   
    Label4.Caption = " Listelenen Kayıt : " & ListBox1.ListCount
   
    If Satır = 0 Then
        ListBox1.RowSource = "'VERİ'!D5:D" & S1.Cells(Rows.Count, 4).End(3).Row
        Label4.Caption = " Listelenen Kayıt : " & ListBox1.ListCount
        MsgBox "Uygun kayıt bulunamadı !", vbCritical
    Else
        ListBox1.ListIndex = 0
    End If
End Sub

Private Sub UserForm_Initialize()
    Me.Caption = "Otomatik Anımsatıcı"
    ListBox1.ColumnCount = 1
    ListBox1.ColumnWidths = "450"
End Sub

Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = vbKeyEscape Then Unload Me
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Set BUL = Nothing
    Set S1 = Nothing
End Sub

ormann · 28 Kasım 2019

Ömer bey merhabalar ; benim dosyada hata verdi. Rica etsem sizin dosyayı link olarak ekler misiniz ?

Ömer · 28 Kasım 2019

Ektedir.

İndir yardım

Dosyayı indir yardım

dosya.co

ormann · 28 Kasım 2019

Sayın Ömer hocam çok teşekkür ederim. Ekli dosyamda makro bütün sayfalarda C4 hücresinde çalışıyor. Bunu sadece istenilen sayfalarda ve istenilen hücrelerde çalıştırabilir miyiz. Örneğin Ali sayfasında C4, A sayfasında K10:K50 , B sayfasında D20 hücresinde ,C sayfasında F10 olacak şekilde yapabilir miziniz?

İndir yardım

Dosyayı indir yardım

dosya.co

ormann · 29 Kasım 2019

Merhabalar,
5 nolu mesajında belirtmiş olduğum konuya yardımcı olur musunuz ?.Saygılar

Ömer · 29 Kasım 2019

Ürün cinslerinin alınacağı yer sabit mi? Yani tüm sayfalar için Ali sayfasındaki J12:J61 aralığı mı?

ormann · 29 Kasım 2019

Ömer bey sadece ekli dosyada A ve D sayfası ALİ sayfasında sarı renk ile belirtmiş olduğum yerler M12:M61 hücre aralığından ; diğer sayfalardaki sarı renkli hücrelerde belirmiş olduğum yerler ise J12:J61 aralığından alabilir mi ?

İndir yardım

Dosyayı indir yardım

dosya.co

Ömer · 29 Kasım 2019

Dosyanız ektedir.
Not: Detaylı deneme yapmadım.

İndir yardım(y)

Dosyayı indir yardım(y)

dosya.co

.

ormann · 29 Kasım 2019

Ömer bey gayet güzel çalışıyor.Sizden ricam D sayfasındaki hücre aralığı ALİ sayfasında J12:J61 hücre aralığından alabilir mi? .Ayrıca B ile C sayfasındaki sarı renkli hücrelerdeki yerler birleştirilmiş hücrelerde çalışabilir mi?

Ömer · 29 Kasım 2019

Bu çalışma sayfası ve Userform1 deki kod sayfalarının en başındaki;

Kod:

    syf = Array("ALİ", "a", "b", "c", "D")
    aln1 = Array("C4", "K10:K50", "D20", "F10", "F9:F49")
    aln2 = Array("J12:J61", "M12:M61", "J12:J61", "J12:J61", "M12:M61")

bu bölümlerdeki alanları değiştirerek istediğinizi yapabilirsiniz. Dizi elamanları sıralıdır.

Burada denmek istenen;
örneğin ALİ sayfasındayken C4 hücresini tetikle veriyi J12:J61 den al.
örneğin a sayfasındayken K10:K50 hücresini tetikle veriyi M12:M61 den al.

Bu şekilde dinamik yaptım ki siz istediğiniz gibi üzerinde oynayabilirsiniz.

Birleştirilmiş hücreler içinde; birleşen alanın tamamını yazın. Örneğin A1:C10 aralığını birleştirdiyseniz A1:A10 değil de A1:C10 olarak tanımlama yapın.

ormann · 29 Kasım 2019

Ömer bey birleştirilmiş hücrede süzme yapmıyor.Tümünü getiriyor.

Ömer · 29 Kasım 2019

Sorunuzu destekleyen örnek dosya ekleyiniz.

ormann · 29 Kasım 2019

Ömer bey tanımlar sayfasında C4 ve B sayfasında D20 birleştirilmiş hücresinde süzme yapmıyor.

İndir yardım(y)

Dosyayı indir yardım(y)

dosya.co

Ömer · 29 Kasım 2019

Denedim, yapıyor. Olmayan işlemin nasıl olmadığını ayrıntılı yazar mısınız. Tam hangi hücrede ne yazınca hangi işlem sonucunda olmayan nedir?

ormann · 29 Kasım 2019

Tanımlar birleştirilmiş hücreye Kn yazdığımda userforma Kn içeren veriler gelmesi gerekirken tüm veriler geliyor.

Ömer · 29 Kasım 2019

Userform1 içindeki.;

Private Sub UserForm_Activate()

Kodları altında bulunan;

If ActiveCell = "" Or Selection.Cells.Count > 1 Then

Bölümdeki kırmızı alanı silerek denermisiniz.

.

ormann · 29 Kasım 2019

Sayın Ömer hocam çok teşekkür ederim. Kodlar çok şahane çalışıyor. Belirtilen hücrelere veri girip enter tuşuna bastığımızda Userform1 açılıyor.Bunu belirtmiş olduğumuz hücrelere veri girdiğimizde direk olarak userform1 açılabilir mi ?

Makroyu Birleştirilmiş Hücrede Çalıştırma

ormann

İndir yardım

Ömer

Moderatör

Ekli dosyalar

ormann

Ömer

Moderatör

İndir yardım

ormann

İndir yardım

ormann

Ömer

Moderatör

ormann

İndir yardım

Ömer

Moderatör

İndir yardım(y)

Ekli dosyalar

ormann

Ömer

Moderatör

ormann

Ömer

Moderatör

ormann

İndir yardım(y)

Ömer

Moderatör

ormann

Ömer

Moderatör

ormann