Liste halinde veri alma

[topcuexcel]

Merhabalar
Tablodaki verilere karşı gelen değerleri liste halinde görebilir miyim?
Ekteki dosyada örneğimi ekledim.

 

[Mustafa MUTLU]

2003 Formatında eklerseniz
yardımcı olmaya çalışırım.

 

[İhsan Tank]

Merhabalar
Tablodaki verilere karşı gelen değerleri liste halinde görebilir miyim?
Ekteki dosyada örneğimi ekledim.

Merhaba
Sayfa1'in kod bölümüne kopyalayın ve deneyin.

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("F3")) Is Nothing Then Exit Sub
Dim ts
For ts = 2 To Cells(1048576, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Range("B2:B" & ts), Cells(ts, "B")) = 1 Then
ListBox1.AddItem Cells(ts, "A")
End If
Next
End Sub

F3'den veri seçtiğinizde otomatik listeleme yapar

 

[topcuexcel]

İhsan bey gene teşekkürler.
Allah razı olsun.

 

[İhsan Tank]

İhsan bey gene teşekkürler.
Allah razı olsun.

Rica ederim
:yazici:

 

[topcuexcel]

İhsan bey ya ben iyi incelemeden uyguladım listeme meğerse listede mamul adı değiştikçe o ada karşılık gelen konumları yazıyor. yani aşağıdaki gibi bir tabloda hangi veriyi (açılır listede) seçersem seçeyim hep listboxta {"A11,A29,A39"} çıkıyor.
KONUM MAMUL ADI
A11 KÖŞE RADYATÖR VANASI
A12 KÖŞE RADYATÖR VANASI
A13 KÖŞE RADYATÖR VANASI
A14 KÖŞE RADYATÖR VANASI
A29 KÖŞE RADYATÖR VANASI PEX
A34 KÖŞE RADYATÖR VANASI PEX
A35 KÖŞE RADYATÖR VANASI PEX
A36 KÖŞE RADYATÖR VANASI PEX
A37 KÖŞE RADYATÖR VANASI PEX
A38 KÖŞE RADYATÖR VANASI PEX
A39 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI
A41 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI
A42 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI
A43 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI

Birde gene bu excel dosyam için 2 - 3 gün önce bir makro yazmıştınız. Aşağıdaki gibi uyarladım fakat "If Sheets("Şema").Cells(ts, "B") = Sheets("Şema").Range("H8") Then" bu satırda debug veriyor.(Type Mistmatch)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H8")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim ts, kaplan
Sheets("Veri").Range("B:B").ClearContents
kaplan = 1
For ts = 2 To Sheets("Şema").Cells(65536, "B").End(xlUp).Row
If Sheets("Şema").Cells(ts, "B") = Sheets("Şema").Range("H8") Then
Sheets("Veri").Cells(kaplan, "B") = Sheets("Şema").Cells(ts, "AA")
kaplan = kaplan + 1
End If
Next
For ts = Sheets("Veri").Cells(65536, "B").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Veri").Range("B1:B" & ts), _
Sheets("Veri").Cells(ts, "B")) > 1 Then
Sheets("Veri").Cells(ts, "B") = ""
End If
If Sheets("Veri").Cells(ts, "B") = "" Then
Sheets("Veri").Cells(ts, "B").Delete
End If
Next
Sheets("Veri").Range("B:B").Sort key1:=Sheets("Veri").Range("B1"), _
order1:=xlAscending
Application.ScreenUpdating = True
End Sub

 

[İhsan Tank]

İhsan bey ya ben iyi incelemeden uyguladım listeme meğerse listede mamul adı değiştikçe o ada karşılık gelen konumları yazıyor. yani aşağıdaki gibi bir tabloda hangi veriyi (açılır listede) seçersem seçeyim hep listboxta {"A11,A29,A39"} çıkıyor.
KONUM MAMUL ADI
A11 KÖŞE RADYATÖR VANASI
A12 KÖŞE RADYATÖR VANASI
A13 KÖŞE RADYATÖR VANASI
A14 KÖŞE RADYATÖR VANASI
A29 KÖŞE RADYATÖR VANASI PEX
A34 KÖŞE RADYATÖR VANASI PEX
A35 KÖŞE RADYATÖR VANASI PEX
A36 KÖŞE RADYATÖR VANASI PEX
A37 KÖŞE RADYATÖR VANASI PEX
A38 KÖŞE RADYATÖR VANASI PEX
A39 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI
A41 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI
A42 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI
A43 KÖŞE GERİ DÖNÜŞ RADYATÖR VANASI

Birde gene bu excel dosyam için 2 - 3 gün önce bir makro yazmıştınız. Aşağıdaki gibi uyarladım fakat "If Sheets("Şema").Cells(ts, "B") = Sheets("Şema").Range("H8") Then" bu satırda debug veriyor.(Type Mistmatch)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("H8")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Dim ts, kaplan
Sheets("Veri").Range("B:B").ClearContents
kaplan = 1
For ts = 2 To Sheets("Şema").Cells(65536, "B").End(xlUp).Row
If Sheets("Şema").Cells(ts, "B") = Sheets("Şema").Range("H8") Then
Sheets("Veri").Cells(kaplan, "B") = Sheets("Şema").Cells(ts, "AA")
kaplan = kaplan + 1
End If
Next
For ts = Sheets("Veri").Cells(65536, "B").End(xlUp).Row To 1 Step -1
If WorksheetFunction.CountIf(Sheets("Veri").Range("B1:B" & ts), _
Sheets("Veri").Cells(ts, "B")) > 1 Then
Sheets("Veri").Cells(ts, "B") = ""
End If
If Sheets("Veri").Cells(ts, "B") = "" Then
Sheets("Veri").Cells(ts, "B").Delete
End If
Next
Sheets("Veri").Range("B:B").Sort key1:=Sheets("Veri").Range("B1"), _
order1:=xlAscending
Application.ScreenUpdating = True
End Sub

Ne istediğiniz anlaşılmıyor. Lütfen örnek dosyada anlatınız

 

[topcuexcel]

İhsan bey ekteki dosyada mamul adını seçtiğim de hata veriyor.
(Yukarıda anlatmak istediğim hata)