BİR HÜCRENİN GRUP UZANTILARI yardım

[PHÖNİX1]

BİR HÜCRENİN GRUP UZANTILARI
her hangi bir hücreye ağaç dalı gibi uzatarak işleyerek ekteki dosyada örnekteki şekilde yapabilirmiyiz.

yardımcı olacak arkadaşlara şimdiden teşekkür ederim.

 

[Ömer]

Merhaba,

Anladığım kadarıyla yapmaya çalıştım.
Örnek dosyayı inceleyiniz. İstediğiniz bu mu?

 

[PHÖNİX1]

Merhaba,

Anladığım kadarıyla yapmaya çalıştım.
Örnek dosyayı inceleyiniz. İstediğiniz bu mu?

ilgine teşekkür ediyorum arkadaş

bu göstermiş olduğun örnektekini zaten veri doğrulama ile ayrı ayrı
hücrede yapıyorum.

c hücresi ile d hücresi gibi olacak orası tamam
ama ilk b hücresine tıkladığımda demir den sonra sağa doğru seçeneklere kaydırdığımda (dövme-yassı-düz) seçtikten sonra devamı sağa doğru fiyatlara
doğru geldiğimde o fiyatın üstüne tıkladığımda c ve d hücresine yazacak

örnek:

b hücresine demir yazacak c hücresi ile d hücresine seçtiklerimin devamı yazacak sadece b hücresinde yana kayarak seçmek istiyorum.

 

[Orion1]

Ekli dosyayı inceleyiniz.

 

[Orion1]

Soruyu yanlış anlamışım.4 numaralı mesajda dosyayı güncelledim.
İndirebilirsiniz.

 

[Orion1]

Topla.Çarpım formülünü koymayı unutmuşum.Şimdi dosyayı güncelledim.
4 nolu mesajdan dosyayı indirebilirsiniz.

 

[PHÖNİX1]

arkadaşlar derdimi anlatamadım galiba

aynı bilgisayarımın masaüstü başlat> proğramlar>donatılar>..... gibi sağa doğru kaydırıp seçeneklerden istediğim yere geldiğimde onun üstüne tıklayıp
o yer açılıyorya onun gibi istiyorum.

başlat yerine( aliminyum - demir-pvc)lerden birisini üstüne gelince >sağa kayıp

proğramlar yerine

o malzemeye bağlı olan örnek: demirin üstüne geldikten sonra demirle ilgili olan

aksesuar (dövme - düz - yassı) lardan birisinin üstüne gelip tekrara sağa kaydığımda fiyatlardan (11ytl-12.5ytl - 13ytl ) lerden birisini tıkladığımda

b hücresine demir yazacak c hücresine seçtiğim aksesuarlardan birisini

d hücresinede fiyatlardan seçtiğimi yazacak.

yeniden yazdım eki

 

[PHÖNİX1]

sayın espijonajl ve evren beye emeğinden dolayı teşekkür ederim.

c hücresi nden sonraki istediğim gibi olmuş ama benim isdediğim

b hücresine tıkladığımda kademe kademe sağa kayarak b hücresi üstünde

istediğim gurupları seçtikden sonra son ytl ye tıklayıp b-c-d hücresine işlesin
istemiştim

c hüresine tıklamadan b hücresinde seçtiklerimi bitirmek istiyorum

değiştirerek ekte göndermiş olduğum dosyada tekrar sarı hücrelerle anlattım


birde nasıl yaptığınızı formülü ile birlikte anlatırsanız memnun olurum

çünkü başka dosyaya aktarmak istiyorum.

yardımlarınız için teşekkür ederim.

 

[PHÖNİX1]

yokmu yardım edecek kimse

 

[Ferhat Pazarçevirdi]

Ekteki örnek dosyayı inceleyiniz.

Siz ilgili tablonun üzerine gelip, sağ mouse tuşuna bastığınızda, Popup menüye bir kontrol daha (Malzeme Seçimi) ilave edilir. Bu sanırım sizin istediğiniz yapı... Malzemeyi seçtiğinizde ilgili satıra ve hücrelere, popupda gördüğünüz bilgileri getirir.

NOTLAR :

1. "Sayfa2"ye grup ve malzemeleri gösteren forma bir tablo ilave edildi. İnceleyiniz. Orjinal dosyanıza adapte ediniz.

2. Modul kısmına (Module1), aşağıdaki kodlar işlendi.

Option Base 1
Public Dugmeler() As Class1
Dim arrG()
Dim arrM()
'-------------------
Sub auto_open()
Call Menu_Olustur
End Sub
'----------------
Sub auto_close()
Call Menu_Sil
End Sub
'----------------
Sub Menu_Olustur()
Dim popA As CommandBarPopup
Dim popG As CommandBarPopup
Dim popM As CommandBarButton
Application.CommandBars("Cell").Reset
Set popA = Application.CommandBars("Cell").Controls.Add(Type:=msoControlPopup)
Call Gruplari_Olustur
With popA
    .Caption = "Malzeme Seçimi"
    .BeginGroup = True
End With
For i = 1 To UBound(arrG)
    Set popG = popA.Controls.Add(Type:=msoControlPopup)
    popG.Caption = arrG(i)
    Malzemeleri_Olustur (arrG(i))
    For k = 1 To UBound(arrM)
        Set popM = popG.Controls.Add(Type:=msoControlButton)
        popM.Caption = arrM(k)
        z = z + 1
        ReDim Preserve Dugmeler(z)
        Set Dugmeler(z) = New Class1
        Set Dugmeler(z).Dugme = popM
    Next k
Next i
End Sub
'----------------
Sub Gruplari_Olustur()
Dim sh As Worksheet
Dim y%, i%, j&, x%
Set sh = Sheets("Sayfa2")
y = 1: ReDim Preserve arrG(y): arrG(y) = sh.Cells(2, 1)
For i = 2 To sh.Cells(65536, 1).End(xlUp).Row
    For j = 1 To UBound(arrG)
        If sh.Cells(i, 1) = arrG(j) Then: x = x + 1
    Next j
    If x = 0 Then
         y = y + 1
         ReDim Preserve arrG(y)
         arrG(y) = sh.Cells(i, 1)
    Else
         x = 0
    End If
Next i
Set sh = Nothing
End Sub
Sub Malzemeleri_Olustur(grup As String)
Dim sh As Worksheet
Dim y%, i%, j&, x%
Set sh = Sheets("Sayfa2")
y = 1: ReDim Preserve arrM(y)
For i = 2 To sh.Cells(65536, 1).End(xlUp).Row
    If sh.Cells(i, 1) = grup Then
       For j = 1 To UBound(arrM)
           If sh.Cells(i, 2) = arrM(j) Then: x = x + 1
       Next j
       If x = 0 Then
           ReDim Preserve arrM(y)
           arrM(y) = sh.Cells(i, 2) & " : " & Format(sh.Cells(i, 3), sh.Cells(i, 3).NumberFormat)
           y = y + 1
       Else
           x = 0
       End If
    End If
Next i
Set sh = Nothing
End Sub
'--------------------
Sub Menu_Sil()
Application.CommandBars("Cell").Reset
End Sub

3. Class Module ilave edildi (Class1)

Option Explicit
Public WithEvents Dugme As CommandBarButton
Private Sub Dugme_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
    With ActiveCell
        If .Row >= 57 Then
           Cells(.Row, 2) = Dugme.Parent.Parent.Caption
           Cells(.Row, 3) = Mid(Dugme.Caption, 1, InStr(1, Dugme.Caption, ":", vbTextCompare) - 1)
           Cells(.Row, 4) = Mid(Dugme.Caption, InStr(1, Dugme.Caption, ":", vbTextCompare) + 2, Len(Dugme.Caption))
           If IsNumeric(Cells(.Row, 4)) Then: Cells(.Row, 4) = Cells(.Row, 4) * 1
        End If
    End With
End Sub

4. Sayfa1'in kod sayfasına aşağıdaki olay kodları yazıldı.

Option Explicit
Private Sub Worksheet_Activate()
   Application.CommandBars("Cell").Controls("Malzeme Seçimi").Enabled = True
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("A57:I100")) Is Nothing Then
   Application.CommandBars("Cell").Controls("Malzeme Seçimi").Enabled = False
Else
   Application.CommandBars("Cell").Controls("Malzeme Seçimi").Enabled = True
End If
End Sub
Private Sub Worksheet_Deactivate()
   Application.CommandBars("Cell").Controls("Malzeme Seçimi").Enabled = False
End Sub

Ben A57:I100 aralığında çalışması için ayarladım, siz isteğinize göre değiştirebilirsiniz.

 

[PHÖNİX1]

FERHAT BEY sen bir harikasın (öyle istememiştim ama) bu şekilde harika olmuş

hiç olmazsa o hücrenin içine değişik malzeme olduğunda işlerim.

veri - doğrulama gibi olsaydı manuel işleyemiyecektim o hücrenin içine.

kusura bakma artık belli bir yaştan sonra kafa almıyor.

çok istiyorum exel üzerinden birşeyler yapmayı ama olmuyor

ana dosya yapmaya çalıştım sayfa birde işlediğim gibi (user form üzerinden) müşteri bilgilerini firma adını, telefon numarasını ,vergi numarasını vs.
girip bir exel dosyası oluşturup içine işlesin istedim.
exel kilitlendi office tekrar kurdum.

emeğin için çok teşekkür ederim.
ellerine sağlık sağol varol.

 

[PHÖNİX1]

sayın Ferhat bey ekte göndermiş olduğum dosyayı incelermisiniz
bir türlü çalıştıramadım.

yardımcı olursanız sevinirim