Delila10 Creative Commons License 2012.04.01 0 0 17634

Az Árajánlat laphoz rendelt makró:

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    
    'Helyfoglalás
    Dim sor As Long, usor As Long, kezd As Long, keres$, sorM As Long
    Dim WS As Worksheet
    
    'Kezdő értékek megadása
    Set WS = Sheets("Árlista")  'A WS változóba tesszük az Árlista lapot
    sor = Target.Row
    
    If Target.Column = 4 Then   'Ha a D (4.) oszlopba írsz
        Range("E" & sor) = ""   'Az aktuális sor E cellája legyen üres
        keres$ = Range("C" & sor) & "_" & Range("D" & sor)  'Értékadás
        Range("M1") = keres$    'Beírás az M1-be
        
        'Hol.van a kezd változóba. A lap 5. oszlopában keres
        kezd = Application.WorksheetFunction.Match(keres$, WS.Columns(5), 0)
        sorM = 1    'Értékadás, majd ide ír az O:P tartományba
        Range("O:P").ClearContents  'Előző O:P törlése
        
        'Első üres sor a WS lapon
        usor = WS.Range("B" & Rows.Count).End(xlUp).Row + 1
        
        'Ciklus, ami kikeresi a keres$ értékhez tartozó sorokat a WS lapon
        'az előzőleg kikeresett "kezd" értéktől kezdve
        For sor = kezd To usor
            'Ha WS lap 5. (E) oszlopa aktuális sorának az értéke =keres$,
            If WS.Cells(sor, 5) = keres$ Then
                Range("O" & sorM) = sor 'az O oszlop sorM-edik cellája az akt. sor száma lesz,
                'a P oszlopba pedig bekerül az INDIREKT függvény
                Cells(sorM, "P") = "=INDIRECT(""'Árlista'!D""&RC[-1])"
                sorM = sorM + 1 'sorM értékének növelése 1-gyel
            Else
                Exit For    'Ha már a WS.E <> keres$, kilépünk a ciklusból
            End If
        Next
    End If
    
    'A méret beírásakor beírja az akt. sor L oszlopába a Főcsop_Alcsop_Méret nevet.
    'Erre hivatkozik a H oszlop képlete.
    'Ez a sor a küldött fájl makrójában az M2-be írt, írd át!
    If Target.Column = 5 Then _
        Range("L" & sor) = Cells(sor, 3) & "_" & Cells(sor, 4) & "_" & Cells(sor, 5)
   
    Application.EnableEvents = True
End Sub

 

Az Árlistához rendelt makró nem változott, a Module1-ben lévőt rendeltem a gombhoz. Az utóbbi az indító lap (Árajánlat) celláit írja át az Árajánlat első üres sorának a megfelelő celláiba.

Előzmény: Alkesz_ (17633)