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

• #13412 Delila_1 veterán jaszy83 #13411

  Új Válasz 2012-04-11 20:37:15 #13412

  Ú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 jaszy83 #13411 üzenetére

  Szívesen. Az éles próba után jelezd, mit kell még javítani rajta.

  Jó szórakozást!
  Neked is van ebed? Indulsz vele?

• #13389 Delila_1 veterán jaszy83 #13388

  Új Válasz 2012-04-08 10:55:37 #13389

  Ú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 jaszy83 #13388 üzenetére

  Az előző makróból hagyd ki a Cells(sor, oszlop) = "K" sort, mivel manuálisan írod be.
  Az uoszlop = Range("IV1").End(xlToLeft).Column sorban az egyenlőség jobb oldala helyett beírhatod fixen az 55 értéket (BD oszlop száma).

  A kézi bevitel után indíthatod a másik makrót, ami a BD oszlopba beírja a legnagyobb elhúzott súlyt.

  Sub LegnSuly()
  Dim sor%, usor As Integer, oszlop%
  
  Sheets("Verseny").Select
  usor = Range("B2").End(xlDown).Row
  
  For sor% = 2 To usor
  For oszlop% = 55 To 5 Step -1
  If Cells(sor, oszlop%) = "K" Then
  Cells(sor, "BD") = Cells(1, oszlop%)
  Exit For
  End If
  Next
  Next
  End Sub

• #13385 Delila_1 veterán jaszy83 #13384

  Új Válasz 2012-04-07 07:57:02 #13385

  Ú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 jaszy83 #13384 üzenetére

  Nem mondhatom, hogy teljesen értem, ritkán húzgálok többszáz kilós súlyokat.
  Most azt gondolom, hogy amelyik súly szerepel a Felvitel lap D oszlopában a név mellett, ahhoz a súlyhoz kell K-t írni a Munka3 lapon.
  

  De honnan jön a H?

  Makró:

  Sub Rendez_2()
  Dim sor As Long, usor As Long, oszlop As Integer, uoszlop As Integer
  Dim WS As Worksheet, WSF As Worksheet
  Application.ScreenUpdating = False
  
  Set WS = Sheets("Munka3") '***************
  Set WSF = Sheets("Felvitel") '***************
  usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
  
  WS.Select
  uoszlop = Range("IV1").End(xlToLeft).Column
  
  'Előző cella-egyesítések megszüntetése
  Columns(1).MergeCells = False
  
  'Előző adatok törlése
  Rows("2:5000").Delete '***************
  
  'Adatok a Felvitel lapról a Munka3-ra
  WSF.Select
  Range("A2:C" & usor).Copy WS.Range("A2")
  
  WS.Select
  
  'Rendezés
  Range(Cells(1, 1), Cells(usor, uoszlop)).Select
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
  .SetRange Range("A1:C" & usor)
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  
  'Cellaegyesítés az A oszlopban, "–" beírása
  For sor = usor To 2 Step -1
  If Cells(sor, 1) = Cells(sor - 1, 1) Then
  Cells(sor - 1, 1) = ""
  Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
  End If
  For oszlop = 5 To uoszlop
  If Cells(1, oszlop) < WSF.Cells(sor, 4) Then
  Cells(sor, oszlop) = "–"
  Else
  Cells(sor, oszlop) = "K"
  Exit For
  End If
  Next
  Next
  
  'Keret
  Range(Cells(1, 1), Cells(usor, uoszlop)).Select
  Selection.Borders(xlEdgeLeft).LineStyle = xlThin
  Selection.Borders(xlEdgeTop).Weight = xlThin
  Selection.Borders(xlEdgeBottom).Weight = xlThin
  Selection.Borders(xlEdgeRight).Weight = xlThin
  Selection.Borders(xlInsideVertical).Weight = xlThin
  Selection.Borders(xlInsideHorizontal).Weight = xlThin
  
  Application.ScreenUpdating = False
  End Sub

• #13376 Delila_1 veterán jaszy83 #13375

  Új Válasz 2012-04-05 07:38:59 #13376

  Ú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 jaszy83 #13375 üzenetére

  Az, hogy kevesebb oszlopod van. Legyen a sor
  uoszlop = Range("IV1").End(xlToLeft).Column

  A makróban úgy vettem, hogy a kezdősúly a Felvitel lap D oszlopában van.

• #13365 Delila_1 veterán jaszy83 #13364

  Új Válasz 2012-04-04 08:37:18 #13365

  Ú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 jaszy83 #13364 üzenetére

  Azt majd megmondod, mi az X és H az egyes sorokban.

  Sub Rendez_1()
  Dim sor As Long, usor As Long, oszlop As Integer, uoszlop As Integer
  Dim WS As Worksheet, WSF As Worksheet
  Application.ScreenUpdating = False
  
  Set WS = Sheets("Munka3") '***************
  Set WSF = Sheets("Felvitel") '***************
  usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
  
  WS.Select
  uoszlop = Range("XFD1").End(xlToLeft).Column
  
  'Előző cella-egyesítések megszüntetése
  Columns(1).MergeCells = False
  
  'Előző adatok törlése
  Rows("2:5000").Delete '***************
  
  'Adatok a Felvitel lapról a Munka3-ra
  WSF.Select
  Range("A2").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Copy WS.Range("A2")
  
  WS.Select
  
  'Rendezés
  Range(Cells(1, 1), Cells(usor, uoszlop)).Select
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
  .SetRange Range("A1:C" & usor)
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  
  'Cellaegyesítés az A oszlopban, "–" beírása
  For sor = usor To 2 Step -1
  If Cells(sor, 1) = Cells(sor - 1, 1) Then
  Cells(sor - 1, 1) = ""
  Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
  End If
  For oszlop = 5 To uoszlop
  If Cells(1, oszlop) < Cells(sor, 4) Then
  Cells(sor, oszlop) = "–"
  Else
  Exit For
  End If
  Next
  Next
  
  'Keret
  Range(Cells(1, 1), Cells(usor, uoszlop)).Select
  Selection.Borders(xlEdgeLeft).LineStyle = xlThin
  Selection.Borders(xlEdgeTop).Weight = xlThin
  Selection.Borders(xlEdgeBottom).Weight = xlThin
  Selection.Borders(xlEdgeRight).Weight = xlThin
  Selection.Borders(xlInsideVertical).Weight = xlThin
  Selection.Borders(xlInsideHorizontal).Weight = xlThin
  
  Application.ScreenUpdating = False
  End Sub

• #13364 jaszy83 csendes tag jaszy83 #13356

  Új Válasz 2012-04-03 22:38:16 #13364

  Ú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

  

  jaszy83

  csendes tag

  válasz jaszy83 #13356 üzenetére

  problem solved,
  büszke vagyok magamra, sikerült fkeres makróval abszolválni hogy negyedik adatnak vigye fel a súlykategóriát:

  Sheets("Rögzítés").Cells(hova, 4) = Application.VLookup(suly, Range("Felvitel!$G$2:$H$12"), 2)

  Viszont újabb segítségre lenne szükségem:
  

  Az adatok lapon felvitt harmadik, kulcsadat a kezdősúly.
  Az itt megadott adatot kellene úgy felhasználni, hogy pl. ha kezdősúlynak 700-at írok be, akkor 600-ig a versenylapon adott versenyző sorába egy minuszt rakjon 600ig (valami olyasmire gondolok hogy a 700 lenne a megadott parameter, amire szükségünk van, az az hogy hány oszlopba írjon adott sorban (tehát a versenyző sorában) E oszloptól kezdve. Mivel E oszloptól indulnak a súlyok 500 kilótól, ezért a képlet a "(parameter-500)/100" lehetne, ez így a példa 700 kilónál 2-t ad ki, és innen valami do-until jellegű dologgal (vagy egyéb lehetséges módon) E oszloptól adott sorban írna minuszt.
  Na ezt így remélem sikerült érthetően leírni kicsit fáradt vagyok.. ;
  előre is köszi a segítséget!

• #13351 Delila_1 veterán jaszy83 #13345

  Új Válasz 2012-03-30 13:11:45 #13351

  Ú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 jaszy83 #13345 üzenetére

  Gyorsabb futást eredményez az újabb makró, és csak a két lap nevét kell módosítani, meg esetleg az 5000 sort.

  Sub Rendez()
  Dim sor As Long, usor As Long, oszlop As Integer
  Dim WS As Worksheet, WSF As Worksheet
  Application.ScreenUpdating = False
  
  Set WS = Sheets("Munka3") '***************
  Set WSF = Sheets("Felvitel") '***************
  usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
  
  WS.Select
  oszlop = Range("XFD1").End(xlToLeft).Column
  
  'Előző cella-egyesítések megszüntetése
  Columns(1).MergeCells = False
  
  'Előző adatok törlése
  Rows("2:5000").Delete '***************
  
  'Adatok a Felvitel lapról a Munka3-ra
  WSF.Select
  Range("A2").Select
  Range(Selection, Selection.End(xlToRight)).Select
  Range(Selection, Selection.End(xlDown)).Copy WS.Range("A2")
  
  WS.Select
  
  'Rendezés
  Range(Cells(1, 1), Cells(usor, oszlop)).Select
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
  .SetRange Range("A1:C" & usor)
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  
  'Cellaegyesítés az A oszlopban
  For sor = usor To 2 Step -1
  If Cells(sor, 1) = Cells(sor - 1, 1) Then
  Cells(sor - 1, 1) = ""
  Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
  End If
  Next
  
  'Keret
  Range(Cells(1, 1), Cells(usor, oszlop)).Select
  Selection.Borders(xlEdgeLeft).LineStyle = xlThin
  Selection.Borders(xlEdgeTop).Weight = xlThin
  Selection.Borders(xlEdgeBottom).Weight = xlThin
  Selection.Borders(xlEdgeRight).Weight = xlThin
  Selection.Borders(xlInsideVertical).Weight = xlThin
  Selection.Borders(xlInsideHorizontal).Weight = xlThin
  
  Application.ScreenUpdating = False
  End Sub

• #13350 Delila_1 veterán jaszy83 #13345

  Új Válasz 2012-03-30 12:52:44 #13350

  Ú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 jaszy83 #13345 üzenetére

  Akkor egyszerűsítsünk!

  A makró a Felvitel lapról veszi az adatokat, és a Munka3 lapra másolja át. Az új tartományt rendezi, majd egyesíti az A oszlop egyesíthető celláit, végül megadja a keretet.
  Mindezek előtt a Munka3 lapot kitakarítja a címsor kivételével.

  Nem tudom, mennyi adatod lesz, a takarítást az A2:K5000 tartományban végeztetem el. Azokat a sorokat, ahol a lapok nevén, vagy a tartományon módosítani kell, csillagokkal kommenteztem.

  Sub Rendez()
  Dim sor As Long, usor As Long, WS As Worksheet, WSF As Worksheet
  
  Set WS = Sheets("Munka3") '***************
  Set WSF = Sheets("Felvitel") '***************
  
  usor = WSF.Range("A" & Rows.Count).End(xlUp).Row
  WS.Select
  
  'Előző cella-egyesítések megszüntetése
  Columns(1).MergeCells = False
  
  'Előző adatok törlése
  Rows("2:5000").Delete '***************
  
  'Adatok a Felvitel lapról a Munka3-ra
  For sor = 2 To usor
  Cells(sor, 1) = WSF.Cells(sor, 1)
  Cells(sor, 2) = WSF.Cells(sor, 2)
  Cells(sor, 3) = WSF.Cells(sor, 3)
  Next
  
  'Rendezés
  Columns("A:K").Select '***************
  ActiveSheet.Sort.SortFields.Clear
  ActiveSheet.Sort.SortFields.Add Key:=Range("A2:A" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  ActiveSheet.Sort.SortFields.Add Key:=Range("C2:C" & usor) _
  , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
  With ActiveSheet.Sort
  .SetRange Range("A1:C" & usor)
  .Header = xlYes
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  
  'Cellaegyesítés az A oszlopban
  For sor = usor To 2 Step -1
  If Cells(sor, 1) = Cells(sor - 1, 1) Then
  Cells(sor - 1, 1) = ""
  Range(Cells(sor - 1, 1), Cells(sor, 1)).MergeCells = True
  End If
  Next
  
  'Keret
  Range("A1:K" & usor).Select '***************
  Selection.Borders(xlEdgeLeft).LineStyle = xlThin
  Selection.Borders(xlEdgeTop).Weight = xlThin
  Selection.Borders(xlEdgeBottom).Weight = xlThin
  Selection.Borders(xlEdgeRight).Weight = xlThin
  Selection.Borders(xlInsideVertical).Weight = xlThin
  Selection.Borders(xlInsideHorizontal).Weight = xlThin
  End Sub

• #13297 Delila_1 veterán jaszy83 #13277

  Új Válasz 2012-03-27 09:09:57 #13297

  Ú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 jaszy83 #13277 üzenetére

  Munka2!A2 -> =Munka1!A2, ezt jobbra húzod C2-ig.

  Munka2!D2 -> =FKERES(C2;$G$1:$H$12;2;0), feltéve, hogy a súlytáblázat a $G$1:$H$12 tartományban van ezen a lapon, G-ben súly, H-ban kategória.

  Munka2!E2 -> =D2+SOR()*0,00001

  Az A2:E2 tartományt lemásolod addig, ameddig adat van a Munka1 lapon.

  Munka3!A2 ->
  =INDEX(Munka2!$A:$D;HOL.VAN(KICSI(Munka2!$E:$E;SOR()-1);Munka2!$E:$E;0);4).

  Ezt jobbra másolod C2-ig, majd a B2-ben az utolsó paramétert, a 4-et átírod 1-re, C2-ben pedig 2-re. A három cellát lemásolod, ameddig kell.

• #13296 lappy őstag jaszy83 #13277

  Új Válasz 2012-03-27 07:48:18 #13296

  Ú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 jaszy83 #13277 üzenetére

  Szia
  Ha egy képet tudnál feltenni ez elképzelésről sokkal egyszer lenne.

• #13295 jaszy83 csendes tag jaszy83 #13277

  Új Válasz 2012-03-26 19:48:12 #13295

  Ú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

  

  jaszy83

  csendes tag

  válasz jaszy83 #13277 üzenetére

  Sziasztok,
  esetleg valaki tudna ebben segíteni?

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