ComboBox a yardım

[akmes]

Merhaba,

Ekteki excel sayfasından da anlaşılacağı gibi combobox işlemi yapmak istiyorum.Fakat bir türlü diğer sayfadaki verileri aktaramıyorum.Bu konuda yardımlarınızı rica ediyorum.

 

[mancubus]

varsayımlar:
1- combo değeri Mac Det sayfasında A sütununda aranıyor.
2- kopyalanacak alan aranan değerin bulunduğu hücrenin 2 satır altından başlıyor (= combo değerinin bulunduğu hücre ile kopyalanacak alan arasında 1 boş satır var.)
3- kopyalanacak alan daima 6 satır ve 8 sütun büyüklüğünde.


bu varsayımlara göre yeni kodlar:

Private Sub ComboBox1_Change()
    
Dim cll As Range
Dim ws As Worksheet

On Error Resume Next

Set ws = Sheets("Mac Det")
Set cll = ws.Columns(1).Find(ComboBox1.Value, LookIn:=xlValues)

If cll Is Nothing Then Exit Sub

cll.Offset(2, 0).Resize(6, 8).Copy Me.Range("F4")

End Sub

Private Sub ComboBox2_Change()
    
Dim cll As Range
Dim ws As Worksheet

On Error Resume Next

Set ws = Sheets("Mac Det")
Set cll = ws.Columns(1).Find(ComboBox2.Value, LookIn:=xlValues)

If cll Is Nothing Then Exit Sub

cll.Offset(2, 0).Resize(6, 8).Copy Me.Range("F14")

End Sub

not1: varsayımlarda hatalı bir durum var ise kodun revize edilmesi gerektiği açıktır.
not2: orijinal koddaki son dolu satır numarasına atanan i değişkeninin ne işe yaradığını anlamadım. sadece bulunuyor ve hiç bir şey yapılmıyor. ben dahil etmedim.

 

[akmes]

varsayımlar:
1- combo değeri Mac Det sayfasında A sütununda aranıyor.
2- kopyalanacak alan aranan değerin bulunduğu hücrenin 2 satır altından başlıyor (= combo değerinin bulunduğu hücre ile kopyalanacak alan arasında 1 boş satır var.)
3- kopyalanacak alan daima 6 satır ve 8 sütun büyüklüğünde.


bu varsayımlara göre yeni kodlar:

Private Sub ComboBox1_Change()
    
Dim cll As Range
Dim ws As Worksheet

On Error Resume Next

Set ws = Sheets("Mac Det")
Set cll = ws.Columns(1).Find(ComboBox1.Value, LookIn:=xlValues)

If cll Is Nothing Then Exit Sub

cll.Offset(2, 0).Resize(6, 8).Copy Me.Range("F4")

End Sub

Private Sub ComboBox2_Change()
    
Dim cll As Range
Dim ws As Worksheet

On Error Resume Next

Set ws = Sheets("Mac Det")
Set cll = ws.Columns(1).Find(ComboBox2.Value, LookIn:=xlValues)

If cll Is Nothing Then Exit Sub

cll.Offset(2, 0).Resize(6, 8).Copy Me.Range("F14")

End Sub

not1: varsayımlarda hatalı bir durum var ise kodun revize edilmesi gerektiği açıktır.
not2: orijinal koddaki son dolu satır numarasına atanan i değişkeninin ne işe yaradığını anlamadım. sadece bulunuyor ve hiç bir şey yapılmıyor. ben dahil etmedim.

Arkadaşım çok teşekkür ederim olmuş, kodlar çalışıyor.Eline, emeğine sağlık.

 

[mancubus]

rica ederim.
kolay gelsin.