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

• #21909 Delila_1 veterán csenor #21907

  Új Válasz 2014-06-06 07:26:30 #21909

  Ú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 csenor #21907 üzenetére

  A makró, amit egy gombhoz rendelhetsz, az Eredmények lap X oszlopába beírja a csapatok nevét, az Y-ba a pontszámot, mindezt csökkenő sorrendben.

  Sub Pont()
  Dim sor As Long, usor As Long
  
  Sheets("Eredmények").Select
  Columns(13).Copy
  Range("X1").PasteSpecial xlPasteValues
  Columns(21).Copy
  Range("Y1").PasteSpecial xlPasteValues
  
  usor = Range("X" & Rows.Count).End(xlUp).Row
  For sor = usor To 2 Step -1
  If InStr(Cells(sor, "X"), "csoport") Or Cells(sor, "X") = "" Then
  Range("X" & sor & ":Y" & sor).Delete
  End If
  Next
  
  'Rendezés
  usor = Range("X" & Rows.Count).End(xlUp).Row
  
  Columns("X:Y").Select
  ActiveWorkbook.Worksheets("Eredmények").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Eredmények").Sort.SortFields.Add Key:=Range( _
  "Y1:Y" & usor), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
  xlSortNormal
  With ActiveWorkbook.Worksheets("Eredmények").Sort
  .SetRange Range("X1:Y" & usor)
  .Header = xlGuess
  .MatchCase = False
  .Orientation = xlTopToBottom
  .SortMethod = xlPinYin
  .Apply
  End With
  
  Range("X1:Y1").Insert Shift:=xlDown
  Range("X1") = "Csapat": Range("Y1") = "Pontszám"
  End Sub

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