DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
İyi akşamlar, konu ile ilgili dosya ekte olup çözüm önerilerinizi ve yardımlarınızı rica eder saygılar sunarım.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, [C2:C65536]) Is Nothing Then Exit Sub
If Target = "" Then Exit Sub
With UserForm1
.TextBox1.Value = ActiveCell(1, -1)
.TextBox2.Value = ActiveCell(1, 0)
.TextBox3.Value = ActiveCell(1, 1)
.TextBox4.Value = ActiveCell(1, 2)
.TextBox5.Value = ActiveCell(1, 3)
.TextBox6.Value = ActiveCell(1, 4)
.TextBox7.Value = ActiveCell(1, 5)
.TextBox8.Value = ActiveCell(1, 6)
.TextBox9.Value = ActiveCell(1, 7)
.TextBox10.Value = ActiveCell(1, 8)
.TextBox11.Value = ActiveCell(1, 9)
.TextBox12.Value = ActiveCell(1, 10)
.TextBox13.Value = ActiveCell(1, 11)
.TextBox14.Value = ActiveCell(1, 12)
.TextBox15.Value = ActiveCell(1, 13)
End With
UserForm1.Show
End Sub
ifadenizden anladığımı uyguladım.İstediğimiz; Bölge yada Farklı Herhangi bir hücernin seçili olan excel sayfasındaki verileri userform'a aktarmasını istiyorum. Yardımlarınızı rica ederim.
Filtreleme yardımı ile seçilen isimlerin Userform'a getirilmesini istiyorum.
Userform üzerinde bulunan ComboBox'dan gireceğim değere uyan ( "B" sütunundaki ) isimlerin yine Userform üzerinde bulunan ListBox'da listelenmesini istiyorum
Private Sub ComboBox1_Change()
Dim sat As Long, s As Long, myarr(), son As Long
Dim deg1, deg2 As String
With ListBox1
.Clear
.ColumnCount = 16
.ColumnWidths = "0,130,0,0,0,0,0,0,0,0,0,0,0,0,0,0"
End With
son = ActiveWorkbook.Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
ReDim myarr(1 To 16, 1 To son)
For sat = 2 To son
deg1 = UCase(Replace(Replace(ActiveWorkbook.Sheets("Sayfa1").Cells(sat, "B"), "ı", "I"), "i", "İ"))
deg2 = UCase(Replace(Replace(ComboBox1, "ı", "I"), "i", "İ"))
If deg1 Like "*" & deg2 & "*" Then
s = s + 1
myarr(1, s) = Cells(sat, "a")
myarr(2, s) = Cells(sat, "b")
myarr(3, s) = Cells(sat, "c")
myarr(4, s) = Cells(sat, "d")
myarr(5, s) = Cells(sat, "e")
myarr(6, s) = Cells(sat, "f")
myarr(7, s) = Cells(sat, "g")
myarr(8, s) = Cells(sat, "h")
myarr(9, s) = Cells(sat, "ı")
myarr(10, s) = Cells(sat, "j")
myarr(11, s) = Cells(sat, "k")
myarr(12, s) = Cells(sat, "l")
myarr(13, s) = Cells(sat, "m")
myarr(14, s) = Cells(sat, "n")
myarr(15, s) = Cells(sat, "o")
myarr(16, s) = Cells(sat, "p")
End If: Next
If s > 0 Then
ReDim Preserve myarr(1 To 16, 1 To s)
ListBox1.Column = myarr
End If
End Sub
Private Sub ListBox1_Click()
TextBox1 = ListBox1.List(ListBox1.ListIndex, 0)
TextBox2 = ListBox1.List(ListBox1.ListIndex, 1)
TextBox3 = ListBox1.List(ListBox1.ListIndex, 2)
TextBox4 = ListBox1.List(ListBox1.ListIndex, 3)
TextBox5 = ListBox1.List(ListBox1.ListIndex, 4)
TextBox6 = ListBox1.List(ListBox1.ListIndex, 5)
TextBox7 = ListBox1.List(ListBox1.ListIndex, 6)
TextBox8 = ListBox1.List(ListBox1.ListIndex, 7)
TextBox9 = ListBox1.List(ListBox1.ListIndex, 8)
TextBox10 = ListBox1.List(ListBox1.ListIndex, 9)
TextBox11 = ListBox1.List(ListBox1.ListIndex, 10)
TextBox12 = ListBox1.List(ListBox1.ListIndex, 11)
TextBox13 = ListBox1.List(ListBox1.ListIndex, 12)
TextBox14 = ListBox1.List(ListBox1.ListIndex, 13)
TextBox15 = ListBox1.List(ListBox1.ListIndex, 14)
End Sub