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 SubDoğ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