[Yardım]  Excel'de toplu sorgulama

VBA Makrolar ile ilgili sormak istedikleriniz, yapmak istedikleriniz hakkında yardım alabileceğiniz bölümdür.

Cevap: Excel'de toplu sorgulama

İleti#61)  feraz » 21 Tem 2018 14:29

Bu dosya tam oldu,Listboxada gerek kalmadı.
Bayağı mantık kurması uğraştırdı fakat doğruysa temiz ve sade oldu.

İyice bir deneyin bence.Kodlarda altta.

Kod: Tümünü seç
Private Sub CommandButton1_Click()

Dim ara As Range, rng As Range, ii As Integer, adres As String
Dim arr

arr = Array("Sayfa1", "tür", "dönen")

Application.ScreenUpdating = False

With Sheets("Sayfa1")
    .Range("G1").Resize(Rows.Count, 250).Clear

    For ii = LBound(arr) To UBound(arr)
     For Each rng In .Range("F1:F" & .Cells(Rows.Count, "F").End(3).Row)
        Set ara = Sheets(arr(ii)).Range("B:B").Find(rng.Value, , , 1)
        If Not ara Is Nothing Then
            adres = ara.Address
            Do
                .Cells(rng.Row, .Cells(rng.Row, Columns.Count).End(xlToLeft).Column + 1) = ara.Offset(0, -1).Value
                .Cells(rng.Row, .Cells(rng.Row, Columns.Count).End(xlToLeft).Column).Font.Color = ara.Offset(0, -1).Font.Color
                Set ara = Sheets(arr(ii)).Range("B:B").FindNext(ara)
            Loop While Not ara Is Nothing And adres <> ara.Address
        End If
     Next
    Next
    .Range("G1").CurrentRegion.Borders.LineStyle = 1 'Cizgi yapar
    .Range("G1").CurrentRegion.HorizontalAlignment = xlCenter 'Ortalama
   
End With

Application.ScreenUpdating = True
MsgBox "Bitti...", vbInformation, "Bitti!!!"
Set ara = Nothing: Set rng = Nothing: adres = vbNullString: Erase arr: ii = Empty

End Sub


Kod: Tümünü seç
Sub kess(kes1)

    Dim kes, bbb As Integer
    Dim i As Integer
   
    Application.ScreenUpdating = True
   
    kes = kes1
   
    Sheets(kes(1)).Activate
    ActiveSheet.Cells(65536, 1).End(3).Select
    ActiveSheet.Range(kes(3)).Select
    ActiveSheet.Range(kes(3)).Font.Color = vbRed
   
    For i = 1 To Len(ActiveSheet.Range(kes(3)).Address)
    sayyy = Mid(ActiveSheet.Range(kes(3)).Address, i, 1)
    If IsNumeric(sayyy) = True Then
    saym = saym & sayyy
    End If
    Next i
   
    Application.ScreenUpdating = False
   
    Erase kes: saym = Emptyi = Empty

End Sub

Kod: Tümünü seç
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column >= 7 And Target.Value <> "" Then

    Dim arrbul(), say As Integer
    Dim ara As Range, ii As Integer, adres As String
    Dim arr, b As Integer
   
   
    arr = Array("Sayfa1", "tür", "dönen")
   
    Application.ScreenUpdating = False
   
    With Sheets("Sayfa1")
   
        For ii = LBound(arr) To UBound(arr)
            Set ara = Sheets(arr(ii)).Range("A:A").Find(Target.Value, , , 1)
            If Not ara Is Nothing Then
                adres = ara.Address
                Do
               
                 If ara.Offset(0, 1).Value = .Range("F" & Target.Row).Value Then
                    ReDim Preserve arrbul(say)
                    arrbul(say) = "Sheets(" & """" & arr(ii) & """" & ")" & ".Range(" & """" & ara.Address(0, 0) & """" & ")"
                    say = say + 1
                 End If
                 
                    Set ara = Sheets(arr(ii)).Range("A:A").FindNext(ara)
                   
                Loop While Not ara Is Nothing And adres <> ara.Address
            End If
        Next
       
            If say > 1 Then
                b = Target.Column - say - 4
                If b = -1 Then b = 0
                kess (Split(arrbul(b), """"))
            Else
                kess (Split(arrbul(0), """"))
            End If
       
    End With
   
    Application.ScreenUpdating = True
   
    Set ara = Nothing: adres = vbNullString: Erase arr: Erase arrbul: ii = Empty: say = Empty: b = Empty

End If

End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#62)  feraz » 22 Tem 2018 00:50

Yine ben :)

Kaç saat bir kod saati için uğraştım sanırım bu kez oldu olmadıysada listbox olanı kullanabilirsiniz :)

Yani kodun uğraştırması birden fazla aynı sonucun çıkmasıyla alakalıydı.

Alttaki kodu aktif yaparsanızda kırmızı olayı gerçekleşir.

Kod: Tümünü seç
'    ActiveSheet.Range(kes(3)).Font.Color = vbRed
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#63)  melek53 » 23 Tem 2018 12:05

62 nolu mesajınız uygulama kırmızı işaretleme yapmıyor,ama hızı çok iyi
61 nolu mesajınız uygulama kırmızı işaretleme yapıyor,ama çok yavaş
Kullanıcı avatarı
melek53
Siteye Alışmış
 
Adı Soyadı:melek yılmaz
Kayıt: 05 Ekm 2009 18:58
Konum: ankara
Meslek: muhasebe
Yaş: 30
İleti: 137
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

Cevap: Excel'de toplu sorgulama

İleti#64)  feraz » 23 Tem 2018 13:57

62.ciyi tekrar okuyabilirmisiniz?
61 e sadece bir kod satır ekledim.Bende hızlı çalışıyor.

Yani ne kadar çok veti bulunursa o kadar yavaşlama olur.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Excel'de toplu sorgulama

İleti#65)  melek53 » 23 Tem 2018 14:22

"Alttaki kodu aktif yaparsanızda kırmızı olayı gerçekleşir."
Bu nasıl yapılır bilemiyorum.

Birde 7. satıra kadar nasıl sabitlediniz?
Kullanıcı avatarı
melek53
Siteye Alışmış
 
Adı Soyadı:melek yılmaz
Kayıt: 05 Ekm 2009 18:58
Konum: ankara
Meslek: muhasebe
Yaş: 30
İleti: 137
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

Cevap: Excel'de toplu sorgulama

İleti#66)  feraz » 23 Tem 2018 14:59

Tek tırnak yani ' bunu silinince aktif olur kod.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Excel'de toplu sorgulama

İleti#67)  feraz » 23 Tem 2018 15:02

Sabitlemeyi telefonla biraz zor anlatırım.

Yinede deneyeyim aklımda kaldığı kadarıyla.
Olmazsa Gif te yaparım.

Mesela 8.satırı tüm seçip menüde yanılmıyorsam görünümde olmalı.Orada seçenekler var.Onlardan birisi.Link bulusam atarım.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#68)  feraz » 23 Tem 2018 15:03

Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Cevap: Excel'de toplu sorgulama

İleti#69)  melek53 » 23 Tem 2018 16:50

feraz yazdı:https://support.office.com/tr-tr/article/sat%C4%B1rlar%C4%B1-ve-s%C3%BCtunlar%C4%B1-kilitlemek-i%C3%A7in-b%C3%B6lmeleri-dondurma-dab2ffc9-020d-4026-8121-67dd25f2508f

Eline emeğine sağlık.
Çok teşekkür ederim.
Hakkını helal et.
Kullanıcı avatarı
melek53
Siteye Alışmış
 
Adı Soyadı:melek yılmaz
Kayıt: 05 Ekm 2009 18:58
Konum: ankara
Meslek: muhasebe
Yaş: 30
İleti: 137
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

Cevap: Excel'de toplu sorgulama

İleti#70)  feraz » 23 Tem 2018 17:07

Rica ederim,helal olsun.sizde helal edin.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#71)  melek53 » 23 Tem 2018 18:42

Kullandıkça başka isteklerde çıkıyor kusura bakma.
Bir şey daha isteyeceğim,affına sığınarak.
bulduğu hücredeki veriyi kırmızı yapıyor ya; Bunu o satırdaki tüm verileri kırmızı yapabilirmi?
Kullanıcı avatarı
melek53
Siteye Alışmış
 
Adı Soyadı:melek yılmaz
Kayıt: 05 Ekm 2009 18:58
Konum: ankara
Meslek: muhasebe
Yaş: 30
İleti: 137
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

Cevap: Excel'de toplu sorgulama

İleti#72)  feraz » 23 Tem 2018 19:34

Eğer koddaki ActiveSheet.Range(kes(3)).Font.Color = vbRed burayı alttaki gibi yaparsanız tm satırın yazı rengi kırmızı olur.

Kod: Tümünü seç
ActiveSheet.Range(kes(3)).EntireRow.Font.Color = vbRed


Yada alttaki gibi değiştirirseniz ilgili kodu sadece o satırdaki son dolu sütundaki veriye kadar olan yer renklenir.
Alttaki kod daha iyi yani.

Her iki kodda arada boş satırlar olsada renklenir.

Kod: Tümünü seç
Sub kess(kes1)

    Dim kes, bbb As Integer
    Dim i As Integer, sat As Integer, sut As Integer, rng As String
   
    Application.ScreenUpdating = True
   
    kes = kes1
   
    With Sheets(kes(1))
   
    .Activate
    .Cells(65536, 1).End(3).Select
    .Range(kes(3)).Select
   
    rng = .Range(kes(3)).Address
    sat = .Range(kes(3)).Row
    sut = .Cells(sat, .Columns.Count).End(xlToLeft).Column
   
    .Range(.Range(rng), .Cells(sat, sut)).Font.Color = vbRed
   
    For i = 1 To Len(.Range(kes(3)).Address)
    sayyy = Mid(.Range(kes(3)).Address, i, 1)
    If IsNumeric(sayyy) = True Then saym = saym & sayyy
    Next i
    End With
    Application.ScreenUpdating = False
   
    Erase kes: saym = Emptyi = Empty: sat = Empty: sut = Empty: rng = vbNullString

End Sub
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#73)  melek53 » 23 Tem 2018 21:14

Şuan dışardayım.En kısa zamanda deneyeceğim.

Birde, Excel'i android sistemde bu kodları çalıştıran uygulama varmıdır?
Kullanıcı avatarı
melek53
Siteye Alışmış
 
Adı Soyadı:melek yılmaz
Kayıt: 05 Ekm 2009 18:58
Konum: ankara
Meslek: muhasebe
Yaş: 30
İleti: 137
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

Cevap: Excel'de toplu sorgulama

İleti#74)  feraz » 23 Tem 2018 21:36

Malisef kod kısmındaa Android sistem olmuyor.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#75)  feraz » 23 Tem 2018 23:55

Tekrar merhaba.
Düşünüp duruyordum bazen kodlara bakıp niye yazdım

Kod: Tümünü seç
  For i = 1 To Len(.Range(kes(3)).Address)
    sayyy = Mid(.Range(kes(3)).Address, i, 1)
    If IsNumeric(sayyy) = True Then saym = saym & sayyy
    Next i

bu kodları diye bilgisayarı açıp deneyince gereksiz yazmışım.Demekki birşey denemişim :)Ve sildim.

Alttaki dosyayı deneyin.

Kod: Tümünü seç
'    .Range(.Range(rng), .Cells(sat, sut)).Font.Color = vbRed


Burayı yine aktif yapın kırmızı renk için.

Birde şunu yaptım.Eğer hücreye çift tıklamada aranan bulunamazsa hata mesajı ekledim ve tekrar arama yaptırttım.
Çünkü böyle apmazsam arananı bulmuyordu.Muazzam oldu bence.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#76)  melek53 » 24 Tem 2018 17:07

Küçük bir hata var.
Mesela 656-KIZILCAHAMAM arattığımız zaman buluyor ama bulduğu satırı kırmızı yapmıyor hata veriyor.
Kullanıcı avatarı
melek53
Siteye Alışmış
 
Adı Soyadı:melek yılmaz
Kayıt: 05 Ekm 2009 18:58
Konum: ankara
Meslek: muhasebe
Yaş: 30
İleti: 137
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

Cevap: Excel'de toplu sorgulama

İleti#77)  feraz » 24 Tem 2018 17:42

O dosyayı bir yüklermisiniz.
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Cevap: Excel'de toplu sorgulama

İleti#78)  feraz » 24 Tem 2018 17:44

melek53 yazdı:Küçük bir hata var.
Mesela 656-KIZILCAHAMAM arattığımız zaman buluyor ama bulduğu satırı kırmızı yapmıyor hata veriyor.


Koddaki kırmızı boyamayı aktif ettiniz mi?
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#79)  feraz » 24 Tem 2018 17:51

Birde yeni gördüm.
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) kodundaki

alttaki kod Exit Sub bunun altına gelecek, kodun G sütunundan önceki sütunlarda çalışmaması için.

Kod: Tümünü seç
son:
Call hata
Kullanıcı avatarı
feraz
Site Dostu
 
Kayıt: 19 May 2014 19:36
Konum: Almanya
Meslek: İşçi
Yaş: 39
İleti: 5531
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Aksaray

Cevap: Excel'de toplu sorgulama

İleti#80)  melek53 » 24 Tem 2018 18:55

Set ara = Nothing: adres = vbNullString: Erase arr: Erase arrbul: ii = Empty
say = Empty: b = Empty: Erase arr3: Erase arr2: n = Empty: m = Empty: xy = Empty
Exit Sub
End If
son:
Call hata
End Sub

Zaten öyle gözüküyor.
656-KIZILCAHAMAM arattığımız zaman buluyor ama bulduğu satırı kırmızı yapmıyor hata veriyor.
Sayı ararken sıkıntı yok.Buluyor ve çift tıklayınca kırmızı yapıyor
Ama 656-KIZILCAHAMAM diye aradığımız zaman buluyor ama kırmızıya boyamıyor.
Kullanıcı avatarı
melek53
Siteye Alışmış
 
Adı Soyadı:melek yılmaz
Kayıt: 05 Ekm 2009 18:58
Konum: ankara
Meslek: muhasebe
Yaş: 30
İleti: 137
 
Cinsiyet: Bayan
Bulunduğunuz İl / Semt: ankara

ÖncekiSonraki

Forum Genel Makro Soruları

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 2 misafir

cron
Bumerang - Yazarkafe