Re: Özel Seçimli Liste Oluşturmak - feraz - 17/04/2021
Alttaki gibide biraz daha kod kısa olur.
Private Sub CommandButton16_Click()
Dim y As Byte, bulbaslikVeri As Range, bulveri As Range
Dim i As Long, deger As String
Dim syfVeri As Worksheet: Set syfVeri = ThisWorkbook.Sheets("VERÝ")
Dim syftasar As Worksheet: Set syftasar = ThisWorkbook.Sheets("TASARI")
With syftasar
.Range(.Cells(1, 6), .Cells(Rows.Count, Columns.Count)).ClearContents
y = 6
For x = 6 To 14
deger = Me.Controls("ComboBox" & x).Value
If Trim(deger) <> "" Then
.Cells(1, y).Value = deger
i = 2
Do While .Cells(i, 2).Value <> ""
Set bulveri = syfVeri.Columns(2).Find(.Cells(i, "B").Value, , xlValues, 1)
Set bulbaslikVeri = syfVeri.Rows(1).Find(deger, , , , 1)
If Not bulbaslikVeri Is Nothing Then _
.Cells(i, y).Value = syfVeri.Cells(bulveri.Row, bulbaslikVeri.Column)
i = i + 1
Loop
y = y + 1
End If
Next x
End With
syftasar.Cells.EntireColumn.AutoFit
syftasar.Cells.EntireRow.AutoFit
Set bulbaslikVeri = Nothing: Set bulveri = Nothing
Set syfVeri = Nothing: Set syftasar = Nothing
End Sub
RE: Özel Seçimli Liste Oluşturmak - feraz - 17/04/2021
Öncekiler yavaş olursa alttaki kullanılabilir.
Private Sub CommandButton16_Click()
Dim y As Byte, bulbaslikVeri As Range, bulveri As Range, xx As Byte
Dim i As Long, deger As String, arr(), say As Byte, sonTasr As Long
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 vaeri 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
y = comboSayisi_ilk
Application.ScreenUpdating = False
For x = comboSayisi_ilk To comboSayisi_son
deger = Me.Controls("ComboBox" & x).Value
If Trim(deger) <> "" Then
.Cells(1, y).Value = deger
i = 1
Do While .Cells(i, 2).Value <> ""
Set bulveri = syfVeri.Columns(2).Find(.Cells(i + 1, "B").Value, , 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
End If
i = i + 1
Loop
syftasar.Cells(2, y).Resize(UBound(arr), 1).Value = arr
y = y + 1
End If
Next x
Application.ScreenUpdating = True
MsgBox "Bitti"
Erase arr
End With
syftasar.Cells.EntireColumn.AutoFit
syftasar.Cells.EntireRow.AutoFit
Set bulbaslikVeri = Nothing: Set bulveri = Nothing
Set syfVeri = Nothing: Set syftasar = Nothing
End Sub
Doğru çalışırsaki bende çalıştı en ideal ve hızlısı bu oldu.
Private Sub CommandButton16_Click()
Dim y As Byte, 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
y = comboSayisi_ilk
Application.ScreenUpdating = False
For x = comboSayisi_ilk To comboSayisi_son
deger = Me.Controls("ComboBox" & x).Value
If Trim(deger) <> "" Then
.Cells(1, y).Value = deger
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
syftasar.Cells(2, y).Resize(UBound(arr), 1).Value = arr
y = y + 1
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
RE: Özel Seçimli Liste Oluşturmak - hayalibey - 17/04/2021
Zafer Hocam elinize kolunuza sağlık kod aşırı hızlı çalışıyor
Eliniz dert görmesin Hocam
yalnız comboboxlar tasarı sayfasındaki sütun harflerine göre veriyi atsa
Mesela F sutunu comboboxuna bürosunu seçiyorum
N sütunu comboboxuna cep telefonunu seçiyorum olması gereken Sayfayı hazırla butonuna basınca F ve N sütunlarında karşılığının bulunup gelmesi ama
N sütunu için comboboxta seçilen değer aradaki boş olması gereken sütunları boş bırakmadan G sütununs yazıyor.
Hocam arada boş sütun olursa olsun hangi sütuna ait combobox seçilirse sütunun altında sıralansa daha iyi olmaz olmaz mı
RE: Özel Seçimli Liste Oluşturmak - feraz - 17/04/2021
(17/04/2021, 11:44)hayalibey yazdı: Zafer Hocam elinize kolunuza sağlık kod aşırı hızlı çalışıyor
Eliniz dert görmesin Hocam
yalnız comboboxlar tasarı sayfasındaki sütun harflerine göre veriyi atsa
Mesela F sutunu comboboxuna bürosunu seçiyorum
N sütunu comboboxuna cep telefonunu seçiyorum olması gereken Sayfayı hazırla butonuna basınca F ve N sütunlarında karşılığının bulunup gelmesi ama
N sütunu için comboboxta seçilen değer aradaki boş olması gereken sütunları boş bırakmadan G sütununs yazıyor.
Hocam arada boş sütun olursa olsun hangi sütuna ait combobox seçilirse sütunun altında sıralansa daha iyi olmaz olmaz mı Sayfada örnek olarak gösterirmisiniz sonucu
RE: Özel Seçimli Liste Oluşturmak - hayalibey - 17/04/2021
(17/04/2021, 11:47)feraz yazdı: (17/04/2021, 11:44)hayalibey yazdı: Zafer Hocam elinize kolunuza sağlık kod aşırı hızlı çalışıyor
Eliniz dert görmesin Hocam
yalnız comboboxlar tasarı sayfasındaki sütun harflerine göre veriyi atsa
Mesela F sutunu comboboxuna bürosunu seçiyorum
N sütunu comboboxuna cep telefonunu seçiyorum olması gereken Sayfayı hazırla butonuna basınca F ve N sütunlarında karşılığının bulunup gelmesi ama
N sütunu için comboboxta seçilen değer aradaki boş olması gereken sütunları boş bırakmadan G sütununs yazıyor.
Hocam arada boş sütun olursa olsun hangi sütuna ait combobox seçilirse sütunun altında sıralansa daha iyi olmaz olmaz mı Sayfada örnek olarak gösterirmisiniz sonucu Hocam ekran görüntüsünü ekledim gerçek bilgilerin olduğu alanı kararttım
RE: Özel Seçimli Liste Oluşturmak - feraz - 17/04/2021
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?
|