gennaro

Option Explicit
Public r As Long, c As Long, x As Long, Riga As Long, Trovato As Boolean, Marcat, Squadra, sPath, Rws

Sub eNo()
Application.EnableEvents = False
End Sub
Sub eSi()
Application.EnableEvents = True
End Sub
Sub sNo()
Application.ScreenUpdating = False
End Sub
Sub sSI()
Application.ScreenUpdating = True
End Sub

Sub apri()
UserForm1.Show vbModeless
End Sub

Sub togli()
Dim sh As Worksheet, r, r1, x, k, d1, d2

Set sh = Worksheets("Marcatori")
sNo
sh.Activate
r = sh.Cells(1, 1).End(xlDown).Row
r1 = 21
sh.Range(Cells(2, 20), Cells(r, 23)).ClearContents
sh.Range(Cells(2, 1), Cells(r, 3)).Copy sh.Cells(2, 20)
For k = 2 To r1
    d1 = sh.Cells(k, 32)
    d2 = sh.Cells(k, 33)
    For x = 2 To r
        If d1 = sh.Cells(x, 20) Then sh.Cells(x, 23) = d2
    Next x
Next k

For x = 2 To r 'elimina quelli con 1 solo gol
    If sh.Cells(x, 22) = 1 Then sh.Range(Cells(x, 21), Cells(x, 23)).ClearContents
Next x
'Sheets("Reti").Select
sSI
End Sub


Sub Cerca(dd, n) 'funzione di ricerca della riga/colonna corrispondente ad un dato
On Error Resume Next
Riga = 0
Select Case n
    Case 1: Riga = WorksheetFunction.Match(dd, Marcat, 0) + 1 'cerca categoria in Indici
    Case 2: Riga = WorksheetFunction.Match(dd, Squadra, 0) + 1 'cerca subcategoria in indici
End Select
End Sub

Sub PulisciSquadre()
Range("Squadre").ClearContents
End Sub

Sub toglispazio()
Dim r, x, n

n = 27
r = Cells(Rows.Count, n).End(xlUp).Row
For x = 1 To r
    Cells(x, n) = Replace(Cells(x, n), " ", "")
Next x
End Sub

Sub Aggiorna()
  Sheets("Classifica").Select
  ActiveSheet.Unprotect
  Range("B26:C45").Select
  Selection.Copy
  Range("B3").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
  Range("B3:C22").Select
  Application.CutCopyMode = False
  Selection.Sort Key1:=Range("C3"), Order1:=xlDescending, Key2:=Range("B3") _
      , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
      False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
      :=xlSortNormal
  Range("B3").Select
  ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

Sub chiudi()
Application.DisplayAlerts = False
ActiveWorkbook.Save
Application.Quit
Application.DisplayAlerts = True
End Sub

Sub Marcatori()
Dim r As Long
sNo
    Sheets("Marcatori").Select
    r = Cells(Rows.Count, 1).End(xlUp).Row
    Range("A1:C" & r).Select
    ActiveWorkbook.Worksheets("Marcatori").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Marcatori").Sort.SortFields.Add Key:=Range( _
        "C2:C" & r), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Marcatori").Sort.SortFields.Add Key:=Range( _
        "A2:A" & r), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Marcatori").Sort.SortFields.Add Key:=Range( _
        "B2:B" & r), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Marcatori").Sort
        .SetRange Range("A1:C" & r)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub ordina(d)
If d = 1 Then Call OrdE2("Marcatori", 1, 1, 3, d, d + 1, 0)
If d = 2 Then Call OrdE2("Marcatori", 1, 1, 3, d, d - 1, 0)
If d = 3 Then Call OrdE2("Marcatori", 1, 1, 3, d, d - 1, 1)
End Sub

Public Sub IniCbon(fg, rp, col, n, d) 'inizializza combobox + colonne
sNo
eNo
  Sheets(fg).Select
  If d = 0 Then Riga = Cells(Rows.Count, col).End(xlUp).Row
  If d = 1 Then Riga = Cells(rp, col).End(xlDown).Row
  If Cells(rp + 1, col) = "" Then Riga = rp + 1
  Rws = Range(Cells(rp + 1, col), Cells(Riga, col + n)).Address
eSi
sSI
End Sub

Public Function TrovDat(fg, rp, col, Nome) 'trova dati in colonna
Dim elenco As Range, Cl As Range
  Sheets(fg).Select
  Riga = Cells(Rows.Count, col).End(xlUp).Row
  If Cells(rp + 1, col) = "" Then Riga = rp + 1
  Set elenco = Range(Cells(rp + 1, col), Cells(Riga, col))
  Trovato = False
  If IsNumeric(Nome) Then Nome = Val(Nome)
  For Each Cl In elenco
    If Cl = Nome Then
      Riga = Cl.Row
      Trovato = True
      Exit For
    End If
  Next Cl
End Function

Public Function OrdC(fg, rp, cop) 'ordina colonna
Dim vert As Long
  Sheets(fg).Select
  If Cells(rp + 1, cop) = "" Then Exit Function
  vert = Cells(Rows.Count, cop).End(xlUp).Row
  Range(Cells(rp, cop), Cells(vert, cop)).Select
  Selection.Sort Key1:=Cells(rp + 1, cop), Order1:=xlAscending, Header:=xlYes, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  Cells(1, 1).Select
End Function

Public Sub OrdE(fg, rp, cop, cof, coo, oo)
Dim vert&

  Sheets(fg).Select
  If Cells(rp + 1, cop) = "" Then Exit Sub
  vert = Cells(rp, cop).End(xlDown).Row
  Range(Cells(rp, cop), Cells(vert, cof)).Select
  If oo = 0 Then
      Selection.Sort Key1:=Cells(rp + 1, coo), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End If
  If oo = 1 Then
      Selection.Sort Key1:=Cells(rp + 1, coo), Order1:=xlDescending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
  End If
  Cells(1, 1).Select
End Sub

Public Sub OrdE2(fg, rp, cop, cof, co1, co2, oo)
Dim vert&

  Sheets(fg).Select
  If Cells(rp + 1, cop) = "" Then Exit Sub
  vert = Cells(rp, cop).End(xlDown).Row
  Range(Cells(rp, cop), Cells(vert, cof)).Select
  If oo = 0 Then
    Selection.Sort Key1:=Cells(rp + 1, co1), Order1:=xlAscending, Key2:=Cells(rp + 1, co2) _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
  End If
  If oo = 1 Then
    Selection.Sort Key1:=Cells(rp + 1, co1), Order1:=xlDescending, Key2:=Cells(rp + 1, co2) _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
  End If
  Cells(1, 1).Select
End Sub

Public Function iniz(dat) 'iniziale maiuscola
Dim L0, L1, L2, L3
L1 = Len(dat)
For x = 1 To L1
  L0 = Mid(dat, x + 1, 1)
  L2 = Mid(dat, x, 1)
  If L2 = " " Then
    L2 = L2 + UCase(L0)
    x = x + 1
  End If
  If x = 1 Then L2 = UCase(L2)
  L3 = L3 + L2
Next x
iniz = L3
End Function

Sub mettipunto()
Dim x

For x = 2 To 108
    Cells(x, 15) = Cells(x, 17) & " " & Cells(x, 16) & "."
Next x


End Sub