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

• #13385 Delila_1 Topikgazda 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

  Topikgazda

  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

  Programozó: hibás programok megírására és kijavítására kiképzett szakember. Többet ésszel, mint ész nélkül.

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