Moderatori: Anthony47, Flash30005
Dim I As Long, J As Long, AvaiLab As String, PreVal As String 'RIGOROSAMENTE IN TESTA
Private Sub Worksheet_Change(ByVal Target As Range)
Dim myMatch, myRan As String, myRC As Long, myC As Range
'
AvaiLab = "2019-20 piano partite" '<<< Foglio delle disponibilita'
myRan = "C1:F1" '<<< L'intestazione delle colonne da compilare
'
myRC = Range(myRan).Cells(1, 1).Column
For Each myC In Target
If Not Application.Intersect(Target, Range(myRan).Offset(1, 0).Resize(1000)) Is Nothing Then
If myC.Value <> "" Then
myMatch = Application.Match(myC.Value, Sheets(AvaiLab).Range("A1:AZ1"), False)
If Not IsError(myMatch) Then
Sheets(AvaiLab).Cells(I, myMatch) = Left(Cells(1, Target.Column), 1)
End If
myC.Offset(0, 1).Select
Else
Application.EnableEvents = False
Cells(myC.Row, myRC).Resize(1, Range(myRan).Columns.Count).ClearContents
For J = 5 To Sheets(AvaiLab).Range("A1:AZ1").Columns.Count
If UCase(Sheets(AvaiLab).Cells(I, J)) <> "X" Then Sheets(AvaiLab).Cells(I, J).ClearContents
Next J
Application.EnableEvents = True
End If
End If
Next myC
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim MData As Double, MTeam As String, CRow As Long
Dim VaStr As String, myRan As String
'
AvaiLab = "2019-20 piano partite" '<<< Foglio delle disponibilita'
myRan = "C1:F1" '<<< L'intestazione delle colonne da compilare
'
If Target.Count = 1 And Not Application.Intersect(Target, Range(myRan).Offset(1, 0).Resize(1000)) Is Nothing Then
CRow = Selection.Row
MData = Round(Cells(CRow, "A"), 5)
MTeam = UCase(Cells(CRow, "B"))
VaStr = ""
If MData > Int(Now) And Len(MTeam) > 1 Then
For I = 2 To Sheets(AvaiLab).Cells(Rows.Count, 2).End(xlUp).Row
If Round(Sheets(AvaiLab).Cells(I, "C").Value, 5) = MData And UCase(Sheets(AvaiLab).Cells(I, "B").Value) = MTeam Then
If Target.Value = "" Then
For J = 5 To Sheets(AvaiLab).Cells(1, Columns.Count).End(xlToLeft).Column
If Sheets(AvaiLab).Cells(I, J).Value = "" Then VaStr = VaStr & "," & Sheets(AvaiLab).Cells(1, J)
Next J
End If
Range(myRan).Resize(1000).Validation.Delete
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Mid(VaStr & ",,", 2)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = "Scegli"
.ErrorMessage = "Scegliere nell'elenco"
.ShowInput = True
.ShowError = True
End With
Exit For
End If
Next I
End If
End If
End Sub
Anthony ha scritto:Secondo me sono stato chiaro quanto te
Torna a Applicazioni Office Windows
Aumenta altezza riga in base valore cella Autore: trittico69 |
Forum: Applicazioni Office Windows Risposte: 47 |
Creare un file Excel con fogli visibili in base all'accesso Autore: JanVathek |
Forum: Applicazioni Office Windows Risposte: 28 |
[EXCEL] Inserire righe in base ad una scelta Autore: robist84@gmail.com |
Forum: Applicazioni Office Windows Risposte: 1 |
Restituisce immagine in base a valore cella Autore: apocrimata75 |
Forum: Applicazioni Office Windows Risposte: 3 |
Visitano il forum: raimea e 15 ospiti