Excel Vba Forum - Excelce.Net

SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Çözülen Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: voleclub - 20 Temmuz 2010, 08:20:32

Başlık: listeden tabloya cevirmek
Gönderen: voleclub - 20 Temmuz 2010, 08:20:32

Selam karışık listeden tabloya çevirmek istiyorum


[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

Başlık: Ynt: listeden tabloya cevirmek
Gönderen: Orion1 - 20 Temmuz 2010, 11:37:29

Dosyanız ektedir. 8)

Kod: [Seç]

Option Explicit
Option Base 1
Sub ogrenci_59()
Dim k As Range, i As Long, myarr(), adr As String, a As Long
Dim j As Byte, isim As String, say As Long, var As Boolean
Dim sat As Long
Sheets("Sayfa1").Select
Application.ScreenUpdating = False
Range("G3:I65536").ClearContents
sat = Cells(65536, "B").End(xlUp).Row
If sat < 2 Then Exit Sub
For j = 7 To 9
    isim = Cells(2, j).Value
    Set k = Range("B1:B" & sat).Find(isim, , xlValues, xlWhole)
    If Not k Is Nothing Then
        say = WorksheetFunction.CountIf(Range("B1:B" & sat), isim)
        ReDim myarr(1 To say, 1 To 1)
        adr = k.Address
        Do
            a = a + 1
            myarr(a, 1) = k.Offset(0, -1).Value
            Set k = Range("B1:B" & sat).FindNext(k)
        Loop While Not k Is Nothing And k.Address <> adr
        Cells(3, j).Resize(a, 1) = myarr
        Erase myarr
        var = True
        a = 0
    End If
Next j
Application.ScreenUpdating = True
If var = True Then
    MsgBox "İşlem tamamlandı." & vbLf & _
    "evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End If
End Sub
[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

Başlık: Ynt: listeden tabloya cevirmek
Gönderen: voleclub - 22 Temmuz 2010, 09:30:12

teşekkür ederim bu makrosuzda yapılabilir mi