Seçili olanları listeleme

[NADİR YILDIZ]

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 ?

 

[dEdE]

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.

 

[NADİR YILDIZ]

Sayın dede

olabilir

 

[NADİR YILDIZ]

sayın dede
bakabildiniz mi

 

[NADİR YILDIZ]

Arkadaşlar bu konuda yardımcı olabilirmisiniz

 

[veyselemre]

Merhaba, eki inceleyin.

 

[NADİR YILDIZ]

Veysel bey merhaba

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

iyi çalışmalar

 

[NADİR YILDIZ]

Veysel bey birşey daha

listboxa çizgi eklenemiyor diye biliyorum doğrumudur

teşekkürler

 

[dEdE]

...listboxa çizgi eklenemiyor diye biliyorum doğrumudur...

ListBox a klavuz çizgi yada sutun eklemek

arkadaşlar list box a klavuz çizgi yada sutun çizgisi eklemek istiyorum gerekli kodu bilen var mı bide listBox ta sütınların aralarını daraltmak istiyorum 8 sutundan sonra kaydırma çubuğu çıkıyor yardımlarınızı bekliyorum

www.excel.web.tr

Kulağı tersten göstererek yapılabilirmiş.

 

[veyselemre]

Görünürlük açısından çizgi eklemek olabilir belki.

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

 

[NADİR YILDIZ]

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

 

[veyselemre]

adres tanımı yok sayfa üzerindeki seçili alanı alıyor

 

[NADİR YILDIZ]

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

 

[veyselemre]

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

 

[NADİR YILDIZ]

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

 

[veyselemre]

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

 

[NADİR YILDIZ]

Veysel bey çok çok teşekkür ederim

iyi çalışmalar