Keresés

Köszönöm!

ActiveWorkbook.SaveAs "Mappa teljes útvonala backslash-sel a végén" & Range("b19").Value

Szevasztok!

Segítség kellene...

Egy munkafüzetet szeretnék menteni makróval megadott helyre. A mentett munkafüzet neve a B19 cellában lévő lenne, a mentés helye pedig egy könyvtár valahol a gépen.

Köszönöm!

Egy lehetséges megoldás a képen.

A piros cella képlete:

{=SZORZATÖSSZEG(HA(OFSZET($B$2:$J$2;B10-1;0)=OFSZET($B$2:$J$2;C10-1;0);1;0);HA(OFSZET($B$2:$J$2;B10-1;0)="";0;1))}

Tömbképlet, tehát Ctrl+Shift+Enterrel kell zárni. Lefelé húzható.

A sárga sor az alap, ezt kell módosítanod a saját táblázatodnak megfelelően. B10:C10-től lefelé vannak a sorpárosítások, vagyis hogy a sárgától számítva hányadik sort kell hányadikkal összehasonlítani. A sorpárok listája (B10:C19) bemenő adat, azokat neked kell megadni.

(Ha jól értettem, az üres cellák egyezősége nem jelent találatot.)

Példa 5 listával, összegyűjtöttem, hogy soronkénti listák elemei milyen gyakran fordulnak elő, alul összegeztem, ilyen táblázatom van (első oszlop a listák sorszáma, utána az elemek, amelyik listában van olyan elem, az 1-es, a többi cella üresen marad):

-,a,b,c,d,e,f,g,h,i (az elemek azonosítói)

1.1,1,-,-,1,-,-,1,1

2.1,-,-,1,1,-,1,1,-

3.-,1,1,-,-,1,-,-,-

4.-,1,-,-,1,-,-,1,1

5.1,-,1,1,1,-,-,-,1

ö:3,3,2,3,3,1,2,3,3

A listák közötti közös elemek számát kell meghatározni:

1-2 3

1-3 1

1-4 4

1-5 3

2-3 0

2-4 3

2-5 3

3-4 1

3-5 2

4-5 2

Azért csináltam '1' és 'üres" cellákat, mert igy jobban áttekinthetők az oszlopok, de nagyon macerás igy is végigbogarászni több oszloponként az aktuális két sort.:-(

Így már érthető, vagy az a baj, hogy rossz irányban indultam el, és más megközelítés kellene?

http://prog.hu/tudastar/147475/Hiperhivatkozas+makroval.html

:)

Nekem nem világos, hogy mit kell csinálni...

Erre senki semmit? :-(

Mától 2010-es excel van nálunk is.;)

Viszont tegnap a nyakamba zúdítottak egy rendezéses feladatot, a tegnapi napom csak az adatok begépelésével ment el.:-(

Adott kb. 250 lista, 30-60 közti elemszámmal. Sorba kell rendezni őket aszerint, melyek között van a legnagyobb átfedés. Arra gondoltam, csinálok egy táblázatot és elemenként összegzem őket, de ezzel csak odáig jutottam, hogy tudom, hogy mely elemek milyen gyakran fordulnak elő. Nekem viszont ezt a vizsgálatot az összes kétező két lista összevetésével kellene elvégezni. 

Bármilyen ötletnek örülnék, mert különben rámegy ez a hetem a papírmunkára.:-(

Esetleg nem gondolnád, hogy akkor megoszthatnád azokkal is, akik azon fáradoztak, hogy megoldják helyetted a problémádat?

Ennek szívből örülök, ugyanis még csak másfél órát foglalkoztam a kéréseddel, és bizony nagyon bosszantott volna, ha három óra múlva derül ki, hogy csak az időmet pazaroltam.

Megkaptam más fórumról a megoldást.

Értem...köszönöm.

Az első sor azt mondja meg a fordítónak, hogy futási hiba esetén a második soron folytatódjon a végrehajtás.

Így nem fordulhat elő, hogy az eseménykezelőket letiltjuk (EnableEvents=False), majd egy  programhiba miatt a végrehajtás nem jut el az engedélyezésig (EnableEvents=True), mely utóbbi esetben az események tiltva maradnának. Ha az események tiltva maradnak, akkor a duplakattintást lekezelő kód a továbbiakban egyáltalán nem fog lefutni, amíg vissza nem kapcsolod.

Ja azt elfelejtettem, hogy nem csak a 28. sorban, hanem onnan lefelé lenne jó, ha menne :-)

Nagyon-nagyon-nagy ötletem van, de a kivitelezés picit gondot okoz :-)

A W28 cellába összefűzéssel megjelenik egy név: "197_1"

Azt szeretném, ha a V28-ba duplán kattintva létrehozna egy hiperhivatkozást. Mégpedig a számítógép (szerver) egy megadott mappájából a W28-ban lévő nevű .pdf fájlra hivatkozzon.

Tehát, ha jól működik, akkor a V28-ban lesz egy link, ami a 197_1.pdf fájlra hivatkozik. A kattintás előtt a V28 üres, tehát a link neve a fájl neve lesz egyben.

Ha a jó ember még nem rakta fel a szerverre a fájlt (a makró nem találja), akkor megjelenne egy msgbox, hogy nem találom a fájl.

Egy Balaton szeletet fizetek annak, aki ezt meg tudja oldani :-)

A védelmet úgy raktam a lapra, hogy a zárolt cellát kijelölni se lehessen, így zárolás esetén nem képes a felhasználó dupla klikket nyomni.

Hú, de nagyon beindultatok :-). Köszönöm Jimmy.

A Te két sorod mit csinál?

Nem láttam ezt a hozzászólásodat, mielőtt beírtam az új változatot, amiben megint elkövettem egy hibát. :((

A If Range(Target.Row, 1) <> "ü" Then helyett If Cells(Target.Row, 1) <> "ü" Then kellett volna.

Még mindig nem jó. A változások csak akkor következhetnek be a duplaklikkre, ha az A oszlopban még nincs pipa.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Protect Password:="jelszo", UserInterfaceOnly:=True
    Application.EnableEvents = False
    Dim rng As Range
    
    If Range(Target.Row, 1) <> "ü" Then
        If Not Intersect(Target, Me.Range("F28:F2530")) Is Nothing Then
            Set rng = Range(Intersect(Me.Rows(16), Target.EntireColumn), Target.Offset(-1))
            If rng Is Nothing Then Exit Sub
            Target.Value = Application.WorksheetFunction.Max(rng) + 1
        End If
         
        If Target.Column = 1 Then
            Range(Target.Address) = "ü"
            With Selection.Font
                .Name = "Wingdings"
                .Bold = True
                .ColorIndex = 3
            End With
            Range("A" & Target.Row & ":V" & Target.Row).Select
            With Selection
                .Font.ColorIndex = 3
                .Locked = True
            End With
        End If
         
        If Target.Column = 3 Or Target.Column = 4 _
            Or Target.Column = 12 Then Range(Target.Address) = Date
         
        If Target.Column = 18 Then Range(Target.Address) = "IGEN"
    End If
    
    Cancel = True
    Application.EnableEvents = True
End Sub

Remélem, így már jó lesz.

Ha kiegészíthetem két sorral:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Protect Password:="jelszo", UserInterfaceOnly:=True

    On Error Goto Hiba_esetén
    Application.EnableEvents = False
    
    Dim rng As Range
    If Not Intersect(Target, Me.Range("F28:F2530")) Is Nothing Then
        Set rng = Range(Intersect(Me.Rows(16), Target.EntireColumn), Target.Offset(-1))
        If rng Is Nothing Then Exit Sub
        Target.Value = Application.WorksheetFunction.Max(rng) + 1
    End If
     
    If Target.Column = 1 Then
        ActiveCell = "ü"
        With Selection.Font
            .Name = "Wingdings"
            .Bold = True
            .ColorIndex = 3
        End With
        Range("A" & Target.Row & ":V" & Target.Row).Select
        With Selection
            .Font.ColorIndex = 3
            .Locked = True
        End With
    End If
     
    If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 12 Then _
        Range(Target.Address) = Date
     
    If Target.Column = 18 Then Range(Target.Address) = "IGEN"
    
    Cancel = True

Hiba_esetén:
    Application.EnableEvents = True
End Sub

Egy kicsit gatyába rázva a makró:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ActiveSheet.Protect Password:="jelszo", UserInterfaceOnly:=True
    Application.EnableEvents = False
    
    Dim rng As Range
    If Not Intersect(Target, Me.Range("F28:F2530")) Is Nothing Then
        Set rng = Range(Intersect(Me.Rows(16), Target.EntireColumn), Target.Offset(-1))
        If rng Is Nothing Then Exit Sub
        Target.Value = Application.WorksheetFunction.Max(rng) + 1
    End If
     
    If Target.Column = 1 Then
        ActiveCell = "ü"
        With Selection.Font
            .Name = "Wingdings"
            .Bold = True
            .ColorIndex = 3
        End With
        Range("A" & Target.Row & ":V" & Target.Row).Select
        With Selection
            .Font.ColorIndex = 3
            .Locked = True
        End With
    End If
     
    If Target.Column = 3 Or Target.Column = 4 Or Target.Column = 12 Then _
        Range(Target.Address) = Date
     
    If Target.Column = 18 Then Range(Target.Address) = "IGEN"
    
    Cancel = True
    Application.EnableEvents = True
End Sub

Az End Sub fölé tedd be ezt a sort:

Application.EnableEvents = True

Van egy másik hiba is. A pipa jel formázási része ilyen legyen:

With Selection.Font

.Name = "Wingdings"

.Bold = True 

.ColorIndex = 3 

End With

az általad írt

With Selection.Font.Name = "Wingdings"

.Bold = True

.ColorIndex = 3

End With

helyett.

Az lemaradt, hogy a dupla klikkre simán belép a cellába.

Ez meg mostan mé' nem megyen? :-(

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

ActiveSheet.Protect Password:="jelszó", UserInterfaceOnly:=True

Dim rng As Range

If Not Intersect(Target, Me.Range("F28:F2530")) Is Nothing Then

Set rng = Range(Intersect(Me.Rows(16), Target.EntireColumn), Target.Offset(-1))

If rng Is Nothing Then Exit Sub

Application.EnableEvents = False

Target.Value = Application.WorksheetFunction.Max(rng) + 1

Cancel = True

Application.EnableEvents = True

End If

If Target.Column = 1 Then

ActiveCell = "ü"

With Selection.Font.Name = "Wingdings"

.Bold = True

.ColorIndex = 3

End With

Range("A" & Target.Row & ":V" & Target.Row).Select

With Selection

.Font.ColorIndex = 3

.Locked = True

End With

End If

If Target.Column = 3 Then Range(Target.Address) = Date

Cancel = True

If Target.Column = 4 Then Range(Target.Address) = Date

Cancel = True

If Target.Column = 12 Then Range(Target.Address) = Date

Cancel = True

If Target.Column = 18 Then Range(Target.Address) = "IGEN"

Cancel = True

ActiveSheet.Protect Pass

End Sub

Pedig egy darabig olyan jól muzsikáltak együtt, aztán valamit elradiroztam...

Szívesen.

Köszönöm!

Védett lapról van szó, mert az egyes cellák zárolása csak így érvényesül.

Az "ActiveSheet.Protect UserInterfaceOnly:=True" sor makróból engedélyezi a módosítást.

Ha jelszóval véded a lapot, ezt írd helyette:

ActiveSheet.Protect Password:="Hű_de_titkos_jelszó", UserInterfaceOnly:=True

Az a módszer is jó, amit Te írtál.

Védett lapról van szó, mert az egyes cellák zárolása csak így érvényesül.

Az "ActiveSheet.Protect UserInterfaceOnly:=True" sor makróból engedélyezi a módosítást.

Ha jelszóval véded a lapot, ezt írd helyette:

ActiveSheet.Protect Password:="Hű_de_titkos_jelszó", UserInterfaceOnly:=True

Az a módszer is jó, amit Te írtál.

Köszönöm, remekül működik.

Még a végére beleraktam egyéb dupla kattintást, de a vegyülés is jól megy :-)

Ez a sor mit jelent?

"ActiveSheet.Protect UserInterfaceOnly:=True"

Ha jelszót teszek a lapra, akkor ennek a helyére kellene beírni, hogy:

Pass = "jelszó"   

ActiveSheet.Unprotect Pass

Illetve a végére:

ActiveSheet.Protect Pass