Skip to main content

AccessTr.neT


Özel Seçimli Liste Oluşturmak

Özel Seçimli Liste Oluşturmak

#25
(17/04/2021, 12:24)feraz yazdı: Resimdeki gibi yolladığınız resim için sütunlar aynı değil yanlışmı?Mesela F sütunlarındaki sütun adları farklı hangisi olacak?

[Resim: do.php?img=10915]

Hocam başlıklar veri sayfası ve tasarı sayfası için birebir aynı.
Tasarı sayfasınaveri çekerken veri sayfasındaki ilgili başlığı da kontrol edecek
Siciller ve başlıklar harfi harfine aynı bendeki dosyada
Cevapla
#26
(17/04/2021, 12:29)hayalibey yazdı:
(17/04/2021, 12:24)feraz yazdı: Resimdeki gibi yolladığınız resim için sütunlar aynı değil yanlışmı?Mesela F sütunlarındaki sütun adları farklı hangisi olacak?

[Resim: do.php?img=10915]

Hocam başlıklar veri sayfası ve tasarı sayfası için birebir aynı.
Tasarı sayfasınaveri  çekerken veri sayfasındaki ilgili başlığı da kontrol edecek
Siciller ve başlıklar harfi harfine aynı bendeki dosyada
Tamam abey yolladığınız dosyada aynı değildi galiba anladım halledince dosayı eklerim inşAllah.
Cevapla
#27
(17/04/2021, 12:36)feraz yazdı:
(17/04/2021, 12:29)hayalibey yazdı:
(17/04/2021, 12:24)feraz yazdı: Resimdeki gibi yolladığınız resim için sütunlar aynı değil yanlışmı?Mesela F sütunlarındaki sütun adları farklı hangisi olacak?

[Resim: do.php?img=10915]

Hocam başlıklar veri sayfası ve tasarı sayfası için birebir aynı.
Tasarı sayfasınaveri  çekerken veri sayfasındaki ilgili başlığı da kontrol edecek
Siciller ve başlıklar harfi harfine aynı bendeki dosyada
Tamam abey yolladığınız dosyada aynı değildi galiba anladım halledince dosayı eklerim inşAllah.
Tamam Hocam çok teşekkür ederim
Cevapla
#28
Rica ederim abey  bir iki satır değiştirdim deneyin.

Private Sub CommandButton16_Click()
Dim bulbaslikVeri As Range, bulveri As Range, xx As Byte
Dim i As Long, deger As String, arr(), say As Byte, sonTasr As Long, veri
Dim syfVeri As Worksheet: Set syfVeri = ThisWorkbook.Sheets("VERÝ")
Dim syftasar As Worksheet: Set syftasar = ThisWorkbook.Sheets("TASARI")

Const comboSayisi_ilk As Byte = 6
Const comboSayisi_son As Byte = 14

say = 0
For x = comboSayisi_ilk To comboSayisi_son
    If Me.Controls("ComboBox" & x).Value <> "" Then say = say + 1
Next

If say = 0 Then
    MsgBox "combolardan secim yap...", vbCritical, "Hata"
    Exit Sub
End If

With syftasar
    If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then
        MsgBox " Tasari sayfasinda veri yok...", vbCritical, "Hata"
        Exit Sub
    Else
        sonTasr = .Cells(Rows.Count, 1).End(3).Row
        ReDim arr(1 To sonTasr, 1 To say)
    End If

    .Range(.Cells(1, comboSayisi_ilk), .Cells(Rows.Count, Columns.Count)).ClearContents

    Application.ScreenUpdating = False
    For x = comboSayisi_ilk To comboSayisi_son
        deger = Me.Controls("ComboBox" & x).Value
        If Trim(deger) <> "" Then
            i = 1
            veri = .Range("B2:B" & sonTasr).Value
            For i = 1 To UBound(veri)
                Set bulveri = syfVeri.Columns(2).Find(veri(i, 1), , xlValues, 1)
                Set bulbaslikVeri = syfVeri.Rows(1).Find(deger, , , 1)
                If Not bulbaslikVeri Is Nothing Then
                    For xx = 1 To say
                        arr(i, xx) = syfVeri.Cells(bulveri.Row, bulbaslikVeri.Column)
                    Next xx
                End If
            Next
            .Cells(1, bulbaslikVeri.Column).Value = deger
            syftasar.Cells(2, bulbaslikVeri.Column).Resize(UBound(arr), 1).Value = arr

        End If
    Next x
    Application.ScreenUpdating = True
    MsgBox "Bitti"
    Erase arr: Erase veri
End With
syftasar.Cells.EntireColumn.AutoFit
syftasar.Cells.EntireRow.AutoFit
Set bulbaslikVeri = Nothing: Set bulveri = Nothing
Set syfVeri = Nothing: Set syftasar = Nothing
End Sub
Cevapla
#29
(17/04/2021, 13:28)feraz yazdı: Rica ederim abey  bir iki satır değiştirdim deneyin.

Private Sub CommandButton16_Click()
Dim bulbaslikVeri As Range, bulveri As Range, xx As Byte
Dim i As Long, deger As String, arr(), say As Byte, sonTasr As Long, veri
Dim syfVeri As Worksheet: Set syfVeri = ThisWorkbook.Sheets("VERÝ")
Dim syftasar As Worksheet: Set syftasar = ThisWorkbook.Sheets("TASARI")

Const comboSayisi_ilk As Byte = 6
Const comboSayisi_son As Byte = 14

say = 0
For x = comboSayisi_ilk To comboSayisi_son
    If Me.Controls("ComboBox" & x).Value <> "" Then say = say + 1
Next

If say = 0 Then
    MsgBox "combolardan secim yap...", vbCritical, "Hata"
    Exit Sub
End If

With syftasar
    If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then
        MsgBox " Tasari sayfasinda veri yok...", vbCritical, "Hata"
        Exit Sub
    Else
        sonTasr = .Cells(Rows.Count, 1).End(3).Row
        ReDim arr(1 To sonTasr, 1 To say)
    End If

    .Range(.Cells(1, comboSayisi_ilk), .Cells(Rows.Count, Columns.Count)).ClearContents

    Application.ScreenUpdating = False
    For x = comboSayisi_ilk To comboSayisi_son
        deger = Me.Controls("ComboBox" & x).Value
        If Trim(deger) <> "" Then
            i = 1
            veri = .Range("B2:B" & sonTasr).Value
            For i = 1 To UBound(veri)
                Set bulveri = syfVeri.Columns(2).Find(veri(i, 1), , xlValues, 1)
                Set bulbaslikVeri = syfVeri.Rows(1).Find(deger, , , , 1)
                If Not bulbaslikVeri Is Nothing Then
                    For xx = 1 To say
                        arr(i, xx) = syfVeri.Cells(bulveri.Row, bulbaslikVeri.Column)
                    Next xx
                End If
            Next
            .Cells(1, bulbaslikVeri.Column).Value = deger
            syftasar.Cells(2, bulbaslikVeri.Column).Resize(UBound(arr), 1).Value = arr

        End If
    Next x
    Application.ScreenUpdating = True
    MsgBox "Bitti"
    Erase arr: Erase veri
End With
syftasar.Cells.EntireColumn.AutoFit
syftasar.Cells.EntireRow.AutoFit
Set bulbaslikVeri = Nothing: Set bulveri = Nothing
Set syfVeri = Nothing: Set syftasar = Nothing
End Sub

Hocam malesef ilgili sütun için ComBoBoxta seçilen veri TASARI sayfasında farklı sütuna geliyor malesef
Cevapla
#30
(17/04/2021, 17:07)hayalibey yazdı:
(17/04/2021, 13:28)feraz yazdı: Rica ederim abey  bir iki satır değiştirdim deneyin.

Private Sub CommandButton16_Click()
Dim bulbaslikVeri As Range, bulveri As Range, xx As Byte
Dim i As Long, deger As String, arr(), say As Byte, sonTasr As Long, veri
Dim syfVeri As Worksheet: Set syfVeri = ThisWorkbook.Sheets("VERÝ")
Dim syftasar As Worksheet: Set syftasar = ThisWorkbook.Sheets("TASARI")

Const comboSayisi_ilk As Byte = 6
Const comboSayisi_son As Byte = 14

say = 0
For x = comboSayisi_ilk To comboSayisi_son
    If Me.Controls("ComboBox" & x).Value <> "" Then say = say + 1
Next

If say = 0 Then
    MsgBox "combolardan secim yap...", vbCritical, "Hata"
    Exit Sub
End If

With syftasar
    If WorksheetFunction.CountA(.Range("A2:A" & Rows.Count)) = 0 Then
        MsgBox " Tasari sayfasinda veri yok...", vbCritical, "Hata"
        Exit Sub
    Else
        sonTasr = .Cells(Rows.Count, 1).End(3).Row
        ReDim arr(1 To sonTasr, 1 To say)
    End If

    .Range(.Cells(1, comboSayisi_ilk), .Cells(Rows.Count, Columns.Count)).ClearContents

    Application.ScreenUpdating = False
    For x = comboSayisi_ilk To comboSayisi_son
        deger = Me.Controls("ComboBox" & x).Value
        If Trim(deger) <> "" Then
            i = 1
            veri = .Range("B2:B" & sonTasr).Value
            For i = 1 To UBound(veri)
                Set bulveri = syfVeri.Columns(2).Find(veri(i, 1), , xlValues, 1)
                Set bulbaslikVeri = syfVeri.Rows(1).Find(deger, , , , 1)
                If Not bulbaslikVeri Is Nothing Then
                    For xx = 1 To say
                        arr(i, xx) = syfVeri.Cells(bulveri.Row, bulbaslikVeri.Column)
                    Next xx
                End If
            Next
            .Cells(1, bulbaslikVeri.Column).Value = deger
            syftasar.Cells(2, bulbaslikVeri.Column).Resize(UBound(arr), 1).Value = arr

        End If
    Next x
    Application.ScreenUpdating = True
    MsgBox "Bitti"
    Erase arr: Erase veri
End With
syftasar.Cells.EntireColumn.AutoFit
syftasar.Cells.EntireRow.AutoFit
Set bulbaslikVeri = Nothing: Set bulveri = Nothing
Set syfVeri = Nothing: Set syftasar = Nothing
End Sub

Hocam malesef ilgili sütun için ComBoBoxta seçilen veri TASARI sayfasında farklı sütuna geliyor malesef

Farklı gelmesi imkansız abey Img-grin
Don dosyanızı ekleyin bakayım bir.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task