Új hozzászólás Aktív témák

• #18714 Caipi tag Mythunderboy #18713

  Új Válasz 2013-08-07 10:06:23 #18714

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Caipi

  tag

  válasz Mythunderboy #18713 üzenetére

  Szerintem csak a cellák formátuma lett átállítva

• #13445 Delila_1 veterán Mythunderboy #13444

  Új Válasz 2012-04-17 12:54:42 #13445

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13444 üzenetére

  Nincs mit.

• #13443 Delila_1 veterán Mythunderboy #13442

  Új Válasz 2012-04-17 10:32:44 #13443

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13442 üzenetére

  Sehogy.

• #13405 Delila_1 veterán Mythunderboy #13402

  Új Válasz 2012-04-11 06:41:44 #13405

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13402 üzenetére

  plaschil jól írta, az End Sub elé írd be a mentős sorát.

  2007-ben Mentés másként | Excel 97-2003 verziójú munkafüzet. A füzet xls kiterjesztést kap, 256 oszlop, és 65536 sor lesz az egyes lapjain.

  Az IV1-ből tedd át valami középső helyre a dátumot, mert ez eléggé nyilvánvaló cím, és a felhasználók is olvashatták itt a fórumon a "nagy titkot". Megnyitás után törlik a dátumot, és végtelen ideig használhatják a nagy művedet.

• #13403 plaschil aktív tag Mythunderboy #13402

  Új Válasz 2012-04-10 21:48:26 #13403

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  plaschil

  aktív tag

  válasz Mythunderboy #13402 üzenetére

  Mikor megnyitja csinálj egy automentést makróval.

• #13401 Delila_1 veterán Mythunderboy #13400

  Új Válasz 2012-04-10 17:46:57 #13401

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13400 üzenetére

  Szívesen. Többszöri nekifutásra mégis sikerült közös nevezőre jutnunk.

• #13399 Delila_1 veterán Mythunderboy #13398

  Új Válasz 2012-04-10 16:44:32 #13399

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13398 üzenetére

  Továbbra is a zaro változóba kell beírni, hány napig legyen érvényes a demo.
  Mivel az első megnyitás dátumát csak úgy lehet megjegyezni, ha a füzet tartalmazza, az első lap IV1 cellájába írattam be, hozzáadva a zaro értéket, ez adja a lejárat napját. Ha ez a cella üres (első megnyitás), akkor bekerül oda a lejárat dátuma.
  A további futtatásoknál megvizsgálja a makró, hogy az aktuális dátum >= IV1 értéknél. Ha igen, megy a védelem. Ha nem, jön a szöveg a hátralévő napok számával. Elég lenne az aktuális dátum = IV1 feltétel, de lehet, hogy aznap nem nyitják meg a fájlt.

  Private Sub Workbook_Open()
  Dim lap%, zaro As Date
  zaro = 5
  If Sheets(1).Cells(1, 256) = "" Then
  Sheets(1).Cells(1, 256) = Date + zaro
  Exit Sub
  End If
  
  If Date >= Sheets(1).Cells(1, 256) Or Date - Sheets(1).Cells(1, 256) = 0 Then
  For lap% = 1 To 5
  Sheets(lap%).Select
  Cells.Locked = True
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
  Scenarios:=True, Password:="mmm"
  Next
  MsgBox "Megmondtam!"
  Else
  MsgBox (Date - Sheets(1).Cells(1, 256)) * -1 & " nap van még hátra!"
  End If
  Sheets(1).Select
  End Sub

• #13397 Delila_1 veterán Mythunderboy #13396

  Új Válasz 2012-04-10 15:29:54 #13397

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13396 üzenetére

  A zaro változóban add meg a lejárat dátumát.

  Private Sub Workbook_Open()
  Dim lap%, zaro As Date
  zaro = "2012.04.15"
  
  If Date >= zaro Then
  For lap% = 1 To 5
  Sheets(lap%).Select
  Cells.Locked = True
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
  Scenarios:=True, Password:="mmm"
  Next
  MsgBox "Megmondtam!"
  Else
  MsgBox zaro - Date & " nap van még hátra!"
  Exit Sub
  End If
  End Sub

  ...és hogy ne kelljen a próbálgatásoknál egyenként feloldanod a lapvédelmeket, és a cellák zárolását:

  Sub Felold()
  Dim lap%
  For lap% = 1 To 5
  Sheets(lap%).Select
  ActiveSheet.Unprotect Password:="mmm"
  Cells.Locked = False
  Next
  End Sub

• #13380 Delila_1 veterán Mythunderboy #13379

  Új Válasz 2012-04-05 13:55:48 #13380

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13379 üzenetére

  Az End Sub fölé:

  MsgBox "Ráfaragtál, Öcsi!"

• #13378 Delila_1 veterán Mythunderboy #13377

  Új Válasz 2012-04-05 11:26:57 #13378

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13377 üzenetére

  Szívesen.

  A If Date > "2012.04.01" Then sorban állíthatod kedved szerint a dátumot.

  Ha a mainál előbbit állítasz be, lefut a makró (akkor a lapok védettségét az "mmm" jelszóval fel tudod oldani, a cellák zárolását pedig az összes cella kijelölésével, és a formátumnál a "Zárolás" megszüntetésével).
  Ha későbbit írsz ebbe a sorba, marad minden úgy, ahogy volt.

• #13373 Delila_1 veterán Mythunderboy #13372

  Új Válasz 2012-04-04 16:58:39 #13373

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13372 üzenetére

  Azt hittem, mást is csinál a makró a lapvédelmen kívül.

  A VB szerkesztőben bal oldalon a ThisWorkbook-ra duplán kattintasz, mire jobb oldalon kapsz egy üres lapot, oda másold be az alábbi kódot.

  Ez minden lap minden celláját zárolja, és a hangzatos "mmm" jelszóval védetté teszi a lapokat. Adj helyette normálisat.

  Mit értsek azon, hogy "adatokat megadni ne tudjanak"?

  Private Sub Workbook_Open()
  Dim lap%
  
  If Date > "2012.04.01" Then
  For lap% = 1 To 5
  Sheets(lap).Select
  Cells.Locked = True
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
  Scenarios:=True, Password:="mmm"
  Next
  Else
  Exit Sub
  End If
  End Sub

• #13370 Delila_1 veterán Mythunderboy #13366

  Új Válasz 2012-04-04 12:30:58 #13370

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #13366 üzenetére

  A VB szerkesztőben a ThisWorkbook-hoz rendeld.

  Private Sub Workbook_Open()
  If Date > "2012.04.02" Then
  Exit Sub
  Else
  
  '***** Ide jön, amit vérge akarsz hajtatni, ha nem járt le a dátum
  
  End If
  End Sub

  Érdemes a makrót levédeni a szerkesztőben a Tools | VBAProject- Properties | Protection fülön, ahol jelszóval tudod letiltani a megnyitását.

• #13368 lappy őstag Mythunderboy #13366

  Új Válasz 2012-04-04 12:02:00 #13368

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  lappy

  őstag

  válasz Mythunderboy #13366 üzenetére

  Szia!
  Makróval biztos megoldható, de ebben csak a nagy tudásúak tudnak majd segíteni!

• #13337 bugizozi őstag Mythunderboy #13336

  Új Válasz 2012-03-29 12:56:33 #13337

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  bugizozi

  őstag

  válasz Mythunderboy #13336 üzenetére

  Munka1 munkalapon

  Private Sub CommandButton1_Click()
  
  Sheets("Munka2").Select
  
  End Sub

  Munka2 munkalapon

  Private Sub CommandButton1_Click()
  
  Sheets("Munka1").Select
  
  End Sub

• #12656 Delila_1 veterán Mythunderboy #12655

  Új Válasz 2012-01-17 12:54:23 #12656

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #12655 üzenetére

  Lehet, hogy a védelem beállítása előtt tervező módban hagytad a vezérlőt.

• #11651 m.zmrzlina senior tag Mythunderboy #11648

  Új Válasz 2011-10-11 13:12:59 #11651

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  m.zmrzlina

  senior tag

  válasz Mythunderboy #11648 üzenetére

  Csak ötletelek, a hogyanról fogalmam sincs.

  Egymásba ágyazott számlálós ciklusokkal összeadnék minden méretet minden mérettel. Minden egyes összeadást addig folytatnék amíg már nem tudok egyetlen még meglévő méretet sem hozzáadni az eredményhez úgy, hogy az ne haladja meg a 6000-t. Ezeket a kombinációkat megtartanám, a 6000 feletti eredményeket eldobnám.

  Aztán felülre rendezném azokat a kombinációkat amelyek értéke leginkább megközelíti a 6000-t (ezeknél legkevesebb a hulladék) és ezekből kiszedném azokat amelyekben pont annyiszor szerepelnek a különböző egyedi méretek ahányszor kellenek.

• #11564 Delila_1 veterán Mythunderboy #11563

  Új Válasz 2011-10-04 15:11:36 #11564

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #11563 üzenetére

  Ha a Munka1 lap A vagy B oszlopába írsz, a makró megcsinálja. Ezt a makrót a lapodhoz kell rendelned - amire több leírást találsz itt a fórumon.

  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 1 Or Target.Column = 2 Then
  Dim WS2 As Worksheet, usor%
  Set WS2 = Sheets("Munka2")
  
  Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _
  CopyToRange:=Sheets("Munka2").Range("A1:B1"), Unique:=True
  
  usor% = WS2.Range("A1").End(xlDown).Row
  WS2.Range("A1:B" & usor%).Sort Key1:=WS2.Range("A2"), Order1:=xlAscending, Header:= _
  xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
  DataOption1:=xlSortNormal
  End If
  End Sub

  Szerk.: a régi makrót töröld ki.

• #11562 Delila_1 veterán Mythunderboy #11561

  Új Válasz 2011-10-04 14:18:58 #11562

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #11561 üzenetére

  Szívesen. Örülök, hogy összejött.

• #11559 Delila_1 veterán Mythunderboy #11558

  Új Válasz 2011-10-04 13:22:57 #11559

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #11558 üzenetére

  A hivatkozási értéken mit értesz? Függvényt?

  Most az A oszlopba képleteket vittem be (amik a D oszlop azonos sorában lévő értéket szorozzák 2-vel). A B oszlopba különböző számokat tettem. A

  Sub EgyeniErtekek()
  Columns("A:B").AdvancedFilter Action:=xlFilterCopy, _
  CopyToRange:=Sheets("Munka2").Range("A1:B1"), Unique:=True
  End Sub

  makró rendben átviszi a Munka2 lapra a két oszlopból azokat a sorokat, ahol az A érték a B-vel együtt egyszer fordul elő. Pl. ha az A oszlopban 2× szerepel 6, a B oszlop hozzájuk tartozó értéke különböző, akkor a Munka2 lapon is 2× lesz ott a 6-os, a különböző B értékkel. Ha viszont mind a két 6-oshoz azonos B tartozik, a másik lapon csak 1× jeleníti meg.

  Az oszlopok első sora cím legyen, lehet hogy ennek hiánya miatt duplázta az első sort.

• #11517 Delila_1 veterán Mythunderboy #11515

  Új Válasz 2011-09-30 13:56:38 #11517

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #11515 üzenetére

  #11513

• #11512 Delila_1 veterán Mythunderboy #11502

  Új Válasz 2011-09-30 12:30:10 #11512

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  Delila_1

  veterán

  válasz Mythunderboy #11502 üzenetére

  A makró az aktuális lap T oszlopába gyűjti az egyéni értékeket, majd átmásolja a Munka2 lap A oszlopába. Másolás után törli az ideiglenes T oszlopot.

  Sub EgyeniErtekek()
  Columns("A:A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
  "T1"), Unique:=True
  Columns("T:T").Copy Sheets("Munka2").Range("A1")
  Columns("T:T").ClearContents
  End Sub

• #11510 MaciLaci68 csendes tag Mythunderboy #11502

  Új Válasz 2011-09-30 12:18:45 #11510

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  MaciLaci68

  csendes tag

  válasz Mythunderboy #11502 üzenetére

  Talán így érthetőbb és látványosabb.
  

• #11506 MaciLaci68 csendes tag Mythunderboy #11502

  Új Válasz 2011-09-30 12:03:55 #11506

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  MaciLaci68

  csendes tag

  válasz Mythunderboy #11502 üzenetére

  Szia,
  Makró nélkül is megy. Egy munkalapon mutatom.

  C oszlop: fejléc: EREDETI ADATOK: itt vannak az adataid egymás alatt C2-től lefelé
  B oszlop:fejléc: SORSZÁMOZÁS: B2-be: =HA(A2<>"";MAX($B$11)+1;"") és ezt húzd le
  A oszlop: fejléc: EZEK KELLENEK: A2-be =HA(HIBÁS(FKERES(C2;$C$11;1;HAMIS));C2;"") és húzd le
  E oszlop: VÉGSŐ ADATOK SORSZÁMA: E2-vel kezdődően 1,2,3...... sorszámot lefelé a végtelenig
  F oszlop fejléc: VÉGEREDMÉNY : F2-be: =FKERES(E2;B;2;HAMIS) és lehúzni

Új hozzászólás Aktív témák