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

• #32567 Delila_1 veterán Zozzy #32565

  Új Válasz 2016-09-02 18:00:13 #32567

  Ú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 Zozzy #32565 üzenetére

  Ha a beírt függvénnyel kész vannak a lapok, nem akarsz mást ellenőrizni, módosítani rajtuk, akkor a mostani makróba az End Sub fölé írd be egy új sorba annak a makrónak a nevét, amelyiket a mentésre kiválasztottad (LapMentes, vagy MentTorol).
  Akkor elég a mostanit indítanod, minden feladatot elvégez.

• #32566 Delila_1 veterán Zozzy #32565

  Új Válasz 2016-09-02 17:45:56 #32566

  Ú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 Zozzy #32565 üzenetére

  Van megoldás.

  Sub Kulon_Lapra_2()
Dim sor As Long, lapnev As String, WS1 As Worksheet, usor As Long

Application.ScreenUpdating = False
Set WS1 = ActiveSheet

'egyedi rekordok az AA oszlopba
WS1.Range("B1:B" & Application.CountA(WS1.Columns(2))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True

sor = 2
Do While Cells(sor, "AA") <> ""
lapnev = Cells(sor, "AA")

WS1.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=lapnev 'szűrés

Sheets.Add After:=Sheets(Sheets.Count) 'új lap létrehozása
ActiveSheet.Name = lapnev

WS1.Range("A1").CurrentRegion.Copy Sheets(lapnev).Cells(1) 'másolás
'képlet az U:W-be
usor = Application.WorksheetFunction.CountA(Columns(22)) + 1
Range("U" & usor & ":W" & usor) = "=subtotal(9,U2:U" & usor - 1 & ")"

WS1.Activate
sor = sor + 1
Loop
WS1.Range("A1").CurrentRegion.AutoFilter Field:=2 'szűrő visszaállítása
Application.ScreenUpdating = True
End Sub

• #32556 Delila_1 veterán Zozzy #32554

  Új Válasz 2016-09-02 10:16:50 #32556

  Ú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 Zozzy #32554 üzenetére

  Akkor gyorsítsunk – bár úgy tapasztaltam, hogy sok sor esetén nem túl gyors az Excelben a szűrés.
  A makró a B oszlop adataiból speciális szűréssel kimásolja az egyedi adatokat az AA oszlopba, onnan veszi, hogy milyen adatokra kell szűrni a tartományt. Ha az AA oszlopban vannak adataid, minden helyen írd át az AA-t nagyobb oszlop nevére.

  Az adatokat tartalmazó lapon állva kell indítani a makrót.

  Sub Kulon_Lapra_1()
Dim sor As Long, lapnev As String, WS1 As Worksheet

Application.ScreenUpdating = False
Set WS1 = ActiveSheet

'egyedi rekordok az AA oszlopba
WS1.Range("B1:B" & Application.CountA(WS1.Columns(2))).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("AA1"), Unique:=True

sor = 2
Do While Cells(sor, "AA") <> ""
lapnev = Cells(sor, "AA")

WS1.Range("A1").CurrentRegion.AutoFilter Field:=2, Criteria1:=lapnev 'szűrés

Sheets.Add After:=Sheets(Sheets.Count) 'új lap létrehozása
ActiveSheet.Name = lapnev

WS1.Range("A1").CurrentRegion.Copy Sheets(lapnev).Cells(1) 'másolás
WS1.Activate
sor = sor + 1
Loop
WS1.Range("A1").CurrentRegion.AutoFilter Field:=2 'szűrő visszaállítása
Application.ScreenUpdating = True
End Sub

• #32553 Delila_1 veterán Zozzy #32552

  Új Válasz 2016-09-02 06:59:15 #32553

  Ú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 Zozzy #32552 üzenetére

  3 makrót írtam. Az első sorra veszi a B oszlop celláit. Ha még nincs ennek megfelelő lap a füzetben, létrehozza, átmásolja a címsort és az aktuális sort. Az új lap neve az aktuális sor B oszlopában lévő adat lesz. Ha már van ilyen nevű lap, az első üres sorába másolja az aktuális sort. Nem kell az első lapon rendezettnek lennie a táblának.

  A második sorra veszi a lapokat a másodiktól az utolsóig, Új füzetbe másolja az aktuális lapot, ezt elmenti a lapnév nevével az utvonal nevű változóban megadott mappába. Ezt a makró elején kell átírnod az
  utvonal = "C:\Temp\"
  sorban a saját mentési útvonaladra.

  Ha az eredeti füzetben nem akarod megtartani az újonnan létrehozott lapokat, akkor a második helyett a harmadik makrót futtasd. Ez nem másolja, hanem áthelyezi a lapokat 1-1 új füzetbe. Itt is át kell írnod az utvonal változó értékét.

  A két másolós makró feltételezi, hogy kezdetkor 1 lap volt a füzetedben.

  Sub Kulon_Lapra()
Dim sor As Long, lapnev As String, a, hova As Long, WS1 As Worksheet

Application.ScreenUpdating = False
Set WS1 = ActiveSheet
sor = 2
Do While Cells(sor, 1) <> ""
lapnev = Cells(sor, "B")
On Error Resume Next
Set a = Sheets(lapnev)
If Err.Number <> 0 Then
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = lapnev
WS1.Rows(1).Copy Sheets(lapnev).Cells(1)
WS1.Activate
End If
On Error GoTo 0

hova = Application.WorksheetFunction.CountA(Sheets(lapnev).Columns(1)) + 1
Rows(sor).Copy Sheets(lapnev).Cells(hova, 1)
sor = sor + 1
Loop
Application.ScreenUpdating = True
End Sub

  Sub LapMentes()
Dim lap As Long, utvonal As String, lapnev As String
utvonal = "C:\Temp\"

Application.ScreenUpdating = False
For lap = 2 To Sheets.Count
lapnev = Sheets(lap).Name
Sheets(lapnev).Copy
ActiveWorkbook.SaveAs Filename:=utvonal & lapnev & ".xlsx"
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub

  Sub MentTorol()
Dim lap As Long, utvonal As String, lapnev As String
utvonal = "C:\Temp\"

Application.ScreenUpdating = False
For lap = Sheets.Count To 2 Step -1
lapnev = Sheets(lap).Name
Sheets(lapnev).Move
ActiveWorkbook.SaveAs Filename:=utvonal & lapnev & ".xlsx"
ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
End Sub

• #26765 azopi74 addikt Zozzy #26763

  Új Válasz 2015-05-01 17:46:11 #26765

  Ú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

  

  azopi74

  addikt

  válasz Zozzy #26763 üzenetére

  Igen azt. Bocsi, nem néztem meg, magyar excelben hogyan fordították az iterációt. Most megtettem.

  Hát valóban közelítésnek bocs, nem akartalak félrevezetni, úgy gondoltam simán hagyták iterációnak vagy iteratív kalkulációnak. De nem, muszáj volt leferdíteni.

  Természetesen nem közelítésről van szó, és az iteráció sem közelítést jelent szó szerint sem, hanem ismétlődést (programozásban ciklus-nak is hívjuk). Csakhát úgy tűnik google translate-tel honosították az excelt
  Ugyanis matematikában valóban majnem a közelítés az iteráció szinonimája, mivel az ismétlődést tartalmazó algoritmusokat a matematikában általában valóban közelítésre szoktuk használni, de IT-ban nem csak (és nem elsősorban). Innen jöhetett a félreferdítés.

• #26760 azopi74 addikt Zozzy #26758

  Új Válasz 2015-05-01 11:29:52 #26760

  Ú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

  

  azopi74

  addikt

  válasz Zozzy #26758 üzenetére

  De legyen azért egy makró mentes megoldás is jó szokásom szerint :

  Iterációt állíts egyre, és írd A2-be:

  =HA(B2<>"";HA(A2="";MOST();A2);"")

• #26756 Fferi50 Topikgazda Zozzy #26753

  Új Válasz 2015-05-01 08:17:30 #26756

  Ú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

  

  Fferi50

  Topikgazda

  válasz Zozzy #26753 üzenetére

  Szia!

  Az A1 cellát másolod és ugyanoda beilleszted értékként, de ez elég macerás minden adatbevitel után.
  Ezért javaslom a következő makrót:

  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column <> 2 Then Exit Sub
  If Target.Value <> "" Then
  Application.EnableEvents = False
  Target.Offset(0, -1).Value = Now()
  Application.EnableEvents = True
  End If
  End Sub

  Ezt úgy viheted be, hogy a munkalapfülre jobb egérgombbal rákattintasz, kód megjelenítése, majd a megjelent kódlapon az üres területre bemásolod.

  A makró azt csinálja, ha a B oszlop egy cellájába adatot írsz (vagy megváltoztatod az ott levő adatot), akkor beírja az A oszlopban mellette levő cellába a Most függvény értékét, ami természetesen nem fog a továbbiakban változni.

  Üdv.

• #26755 Delila_1 veterán Zozzy #26753

  Új Válasz 2015-05-01 08:16:05 #26755

  Ú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 Zozzy #26753 üzenetére

  A laphoz kell rendelned a makrót. Mikor a B oszlopba beírsz valamit, az A oszlop azonos sorában fixen, nem képletként megjelenik az idő. Az oszlop formátumát tetszésed szerint adhatod meg, dátummal, vagy anélkül.

  Ha törölsz a B-ben, az A azonos sorából is törlődik a beírt időpont. Ha 1-nél több cellába viszel be egyszerre adatot, akkor nem ír be semmit.

  Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Count > 1 Then Exit Sub
  If Target.Column = 2 Then
  If Target = "" Then
  Cells(Target.Row, 1) = ""
  Exit Sub
  Else
  Cells(Target.Row, 1) = Now
  End If
  End If
  End Sub

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