Listboxtan excel sayfasına veri raporlama sorunu

[mehmetaliozgur]

Merhaba arkadaşlar

Aşağıdaki kodda görüldüğü üzere additem ile oluşturulmuş listboxlardan rapor sayfasına verileri taşımak istiyorum fakat 16. sütündan ileriye veri aktaramıyorum.
Yardımcı olursanız müteşekkür olurum.

Saygılarımla.

Mehmet Özgür

Private Sub CommandButton2_Click()
Dim i As Integer
Dim j As Integer
Dim satir As Integer
Dim rapor As Worksheet
Dim kontrol As Boolean

kontrol = False
'1##################
For i = 0 To lstRapor.ListCount - 1
    If lstRapor.Selected(i) = True Then
        kontrol = True
        Exit For
    End If
Next i
Set rapor = Worksheets("RAPOR")
rapor.Cells.Clear
For i = 1 To 8
    rapor.Cells(1, i).Value = lstBaslik.Column(i - 1, 0)
Next i
rapor.Range("a1:aw1").Font.Bold = True
satir = 2
If kontrol = False Then
rapor.Range(rapor.Cells(2, 1), rapor.Cells(lstRapor.ListCount + 1, lstRapor.ColumnCount)) = lstRapor.List
Else
For i = 0 To lstRapor.ListCount - 1
    If lstRapor.Selected(i) = True Then
        For j = 0 To lstRapor.ColumnCount - 1
            rapor.Cells(satir, j + 1) = lstRapor.List(i, j)
        Next j
        satir = satir + 1
    End If
'2################################
Next i
End If
kontrol = False
For i = 0 To lstRapor1.ListCount - 1
    If lstRapor1.Selected(i) = True Then
        kontrol = True
        Exit For
    End If
Next i
Set rapor = Worksheets("RAPOR")
For i = 9 To 16
    rapor.Cells(1, i).Value = lstBaslik1.Column(i - 9, 0)
Next i
rapor.Range("a1:aw1").Font.Bold = True
satir = 2
If kontrol = False Then
rapor.Range(rapor.Cells(2, 16), rapor.Cells(lstRapor1.ListCount + 1, lstRapor1.ColumnCount)) = lstRapor1.List
Else
For i = 0 To lstRapor1.ListCount - 1
    If lstRapor1.Selected(i) = True Then
        For j = 0 To lstRapor1.ColumnCount - 1
            rapor.Cells(satir, j + 1) = lstRapor1.List(i, j)
        Next j
        satir = satir + 1
    End If
    '3################################
Next i
End If
kontrol = False
For i = 0 To lstRapor2.ListCount - 1
    If lstRapor2.Selected(i) = True Then
        kontrol = True
        Exit For
    End If
Next i
Set rapor = Worksheets("RAPOR")
For i = 17 To 24
    rapor.Cells(1, i).Value = lstBaslik2.Column(i - 17, 0)
Next i
satir = 2
If kontrol = False Then
rapor.Range(rapor.Cells(2, 24), rapor.Cells(lstRapor2.ListCount + 1, lstRapor2.ColumnCount)) = lstRapor2.List
Next i
Else
For i = 0 To lstRapor2.ListCount - 1
    If lstRapor2.Selected(i) = True Then
        For j = 0 To lstRapor2.ColumnCount - 1
            rapor.Cells(satir, j + 1) = lstRapor2.List(i, j)
        Next j
        satir = satir + 1
    End If
    Next i
    End If
End Sub

 

[Korhan Ayhan]

Selamlar,

Kod yerine örnek dosyanızı ekleyip yapmak istediğiniz işlemi açıklarsanız daha hızlı yanıt alabilirsiniz.

 

[mehmetaliozgur]

Sorunlu dosya ekte. Dosyanın makrosunu incelediğinizde anlayacaksınızdır, vba bildiğim pek söylenemez. Sadece mevcut şekli çözüp istediğim şekilde biçimlendiriyorum.

 

[Korhan Ayhan]

Selamlar,

Dosyanıza göre raporlama mantığınızı anlatırmısınız. Verileri excele aktarırken nelere dikkat etmemiz gerekiyor.

 

[mehmetaliozgur]

Userformdaki değişkenlere göre listboxların içeriği değişiyor ve oluşan listbox içeriklerini başlıklara uygun olarak sıra ile rapor sayfasına aktarmak gerekiyorki oluşan rapor içeriği ile grafik balantıları oluşturulabilsin ve mukayeseler yapılabilsin. Fakat lstrapor ve lstrapor1 isimli listboxları başlıklarına uygun olarak rapor dosyasına alabiliorum fakat lstrapor2 ve diğerleri alınamıyor 16. sütündan sonra lstraporların içeriği aktarılamıyor. Ekli belgede sadece lstrapor ve lstrapor1 çalışır durumda.

 

[halit3]

bu kodu denermisiniz.

Private Sub CommandButton2_Click()
Set rapor = Worksheets("RAPOR")
rapor.Cells.Clear
'On Error Resume Next
sat = 1
sut = 1
For m = 0 To 4
If m = 0 Then
m = ""
Else
m = m
End If
For n = 0 To 7
rapor.Cells(sat, n + sut).Value = Controls("lstBaslik" & m).List(0, n)
Next n
sut = sut + n
m = Val(m)
Next m
sat = sat + 1
For i = 1 To lstRapor1.ListCount
sut = 1
For m = 0 To 4
If m = 0 Then
m = ""
Else
m = m
End If
For n = 0 To 7
rapor.Cells(sat, n + sut).Value = Controls("lstRapor" & m).List(i - 1, n)
Next n
sut = sut + n
m = Val(m)
Next m
sat = sat + 1
Next i
MsgBox "işlem tamam"
End Sub

 

[mehmetaliozgur]

Merhaba

Yazdığınız kod gayet güzel çalıştı. Gösterdiğiniz alâkadan dolayı size ve Korhan bey'e çok teşekür ederim.

Mehmet Özgür

 

[mehmetaliozgur]

Merhaba
Yadığınız kod gayet güzel çalıştı. Gösterdiğiniz alâkadan dolayı size ve Korhan Bey'e çok teşekür ederim.

MehmetÖzgür

 

[halit3]

iyi çalışmalar

 

[mehmetaliozgur]

Merhaba

Yazdığınız Kod gayet güzel çalışıyor.
Gösterdiğiniz alâkadan dolayı size ve Korhan Bey'e çok teşekür ederim.


Mehmet Özgür