• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Seçili olanları listeleme

NADİR YILDIZ

NADİR YILDIZ

Altın Üye
Katılım
7 Ocak 2006
Mesajlar
1,413
Excel Vers. ve Dili
2016 Türkçe
Merhaba

B sütunundaki verileri istediğim alana kadar seçim yaptığımda bu 3 satırda olabilir 10.000 satırda olabilir

D E F G sütunlarındaki gibi olacak şekilde mesaj kutusu şeklinde çıkabilir mi ?
 

Ekli dosyalar

Merhaba,
"...mesaj kutusu şeklinde çıkabilir mi ? "
MsgBox bu tür düzenlemeler için uygun değildir. Bunun yerine küçük bir UserForm istediğinizi yapar.
 
Veysel bey merhaba

çok teşekkür ederim tam istediğim gibi hatta ötesinde

iyi çalışmalar
 
Veysel bey birşey daha

listboxa çizgi eklenemiyor diye biliyorum doğrumudur

teşekkürler
 
Son düzenleme:
Görünürlük açısından çizgi eklemek olabilir belki.
Kod: 
Private Sub UserForm_Initialize()
    Dim veri, liste, i, ii, say, bb, b, ky, miktar, sut, s, uz
    If Selection(1).Value = "" Then Exit Sub
    veri = Selection.Value
    If Not IsArray(veri) Then ReDim veri(1, 1): veri(1, 1) = Selection.Value
    ReDim liste(1 To UBound(veri) + 2, 1 To 1)
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            For Each bb In Split(veri(i, 1), ",")
                b = Split(Trim(bb), " ")
                ky = UCase(Trim(b(1)))
                miktar = CDbl(Trim(b(0)))
                If Not .exists(ky) Then
                    say = say + 1
                    .Item(ky) = say
                    ReDim Preserve liste(1 To UBound(veri) + 2, 1 To say)
                    liste(2, say) = ky
                End If
                sut = .Item(ky)
                liste(1, sut) = liste(1, sut) + miktar
                liste(i + 2, sut) = miktar
            Next bb
        Next i
    End With
    For i = 1 To say
        s = s & ";" & 30
        uz = uz + 32
    Next i
    For i = 1 To UBound(liste)
        For ii = 1 To say
           liste(i, ii) = liste(i, ii) & String(10 - Len(liste(i, ii)), "-")
        Next ii
    Next i
    ListBox1.Width = uz + 0
    ListBox1.Height = (UBound(veri) + 2) * 12
    ListBox1.List = liste
    ListBox1.ColumnCount = say
    ListBox1.ColumnWidths = Mid(s, 2)
    Me.Width = uz + 22
    Me.Height = ((UBound(veri) + 2) * 12) + 35
End Sub
 
Veysel bey teşekkürler

bir şey daha başka bir çalışmamda K sütunundaki veriler için bu kodları kullanacağım
nerelerde değişiklik yapmam gerekiyor
b olanları değiştirdim ancak sonuç alamadım
 
adres tanımı yok sayfa üzerindeki seçili alanı alıyor
 
Veysel bey

* filtreleme yaptığımda filtreli satırları listeleme yapabilirmiyiz

* 25.80 metreyi 2580 olarak alıyor

kusura bakmayın örnek yaptıkça çıktığı için parça parça oldu ama
 

Ekli dosyalar

Kod: 
Private Sub UserForm_Initialize()
    Dim rng, veri, liste, i, ii, say, bb, b, ky, miktar, sut, s, uz

    With CreateObject("Scripting.Dictionary")
        For Each rng In Range("B5:B" & Cells(Rows.Count, 2).End(3).Row).SpecialCells(xlCellTypeVisible).Areas
            If rng.Address = "$B$4" Then Exit Sub
            For Each b In rng.Cells
                .Item(WorksheetFunction.Trim(b)) = Null
            Next b
        Next rng
        veri = .keys
        .RemoveAll
        ReDim liste(1 To UBound(veri) + 3, 1 To 1)
        For i = 0 To UBound(veri)
            For Each bb In Split(veri(i), ",")
                b = Split(WorksheetFunction.Trim(bb), " ")
                ky = UCase(Trim(b(1)))
                miktar = CDbl(Replace(Trim(b(0)), ".", ","))
                If Not .exists(ky) Then
                    say = say + 1
                    .Item(ky) = say
                    ReDim Preserve liste(1 To UBound(veri) + 3, 1 To say)
                    liste(2, say) = ky
                End If
                sut = .Item(ky)
                liste(1, sut) = liste(1, sut) + miktar
                liste(i + 3, sut) = miktar
            Next bb
        Next i
    End With
    For i = 1 To say
        s = s & ";" & 30
        uz = uz + 32
    Next i
    For i = 1 To UBound(liste)
        For ii = 1 To say
            liste(i, ii) = liste(i, ii) & String(10 - Len(liste(i, ii)), "-")
        Next ii
    Next i
    ListBox1.Width = uz + 0
    ListBox1.Height = (UBound(veri) + 3) * 12
    ListBox1.List = liste
    ListBox1.ColumnCount = say
    ListBox1.ColumnWidths = Mid(s, 2)
    Me.Width = uz + 22
    Me.Height = ((UBound(veri) + 3) * 12) + 35
End Sub
 
Veysel bey teşekkürler

ancak burada seçime göre listeleme yapmıyor filtrelenende ne varsa onu listeliyor
ben filtreleme yaptığımda filtrelenenlerden istediklerimi seçtiğimde listeleme yapması gerekiyor

sizi çok uğraştırdım
 

Ekli dosyalar

Kod: 
Private Sub UserForm_Initialize()
    Dim rng, veri, liste, i, ii, say, bb, b, ky, miktar, sut, s, uz, alan, son
    Set alan = Range("B4")
    son = Cells(Rows.Count, 2).End(3).Row
    With CreateObject("Scripting.Dictionary")
        For Each rng In Range("B5:B" & son).SpecialCells(xlCellTypeVisible).Areas
            For Each b In rng.Cells
                Set alan = Union(alan, b)
            Next b
        Next rng
        Set alan = Intersect(alan, Selection, Range("B5:B" & son))
        If alan Is Nothing Then Exit Sub
        For Each b In alan.Cells
            .Item(WorksheetFunction.Trim(b)) = Null
        Next b
        veri = .keys
        .RemoveAll
        ReDim liste(1 To UBound(veri) + 3, 1 To 1)
        For i = 0 To UBound(veri)
            For Each bb In Split(veri(i), ",")
                b = Split(WorksheetFunction.Trim(bb), " ")
                ky = UCase(Trim(b(1)))
                miktar = CDbl(Replace(Trim(b(0)), ".", ","))
                If Not .exists(ky) Then
                    say = say + 1
                    .Item(ky) = say
                    ReDim Preserve liste(1 To UBound(veri) + 3, 1 To say)
                    liste(2, say) = ky
                End If
                sut = .Item(ky)
                liste(1, sut) = liste(1, sut) + miktar
                liste(i + 3, sut) = miktar
            Next bb
        Next i
    End With
    For i = 1 To say
        s = s & ";" & 30
        uz = uz + 32
    Next i
    For i = 1 To UBound(liste)
        For ii = 1 To say
            liste(i, ii) = liste(i, ii) & String(10 - Len(liste(i, ii)), "-")
        Next ii
    Next i
    ListBox1.Width = uz + 0
    ListBox1.Height = (UBound(veri) + 3) * 12
    ListBox1.List = liste
    ListBox1.ColumnCount = say
    ListBox1.ColumnWidths = Mid(s, 2)
    Me.Width = uz + 22
    Me.Height = ((UBound(veri) + 3) * 12) + 35
End Sub
 
Veysel bey çok çok teşekkür ederim

iyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst