Moderatori: Anthony47, Flash30005
Sub Trasponi()
Set Ws1 = Worksheets("Foglio1")
Ws1.Columns("D:IV").ClearContents
UR1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
For RR1 = 2 To UR1
NT = Ws1.Range("C" & RR1).Value
If IsNumeric(NT) Then
CC2 = 3
For RR2 = RR1 - NT To RR1 - 1
CC2 = CC2 + 1
CodP = Ws1.Range("A" & RR2).Value
LTr = InStrRev(CodP, "-")
NTag = Mid(CodP, LTr + 1, Len(CodP) - LTr)
Ws1.Cells(RR1, CC2).Value = NTag
Next RR2
End If
Next RR1
End Sub
Sub Trasponi()
Set Ws1 = Worksheets("Foglio1")
Ws1.Columns("D:IV").ClearContents
UR1 = Ws1.Range("A" & Rows.Count).End(xlUp).Row
RigaIni = 2
For RR1 = 2 To UR1
NT = Ws1.Range("B" & RR1).Value
If NT <> "" Then
CC2 = 3
'Ws1.Cells(RR1, 3).Value = RR1 - RigaIni '<<<<< scommentando questa riga sostituirai le formule della colonna C
For RR2 = RigaIni To RR1 - 1
CC2 = CC2 + 1
CodP = Ws1.Range("A" & RR2).Value
LTr = InStrRev(CodP, "-")
NTag = Mid(CodP, LTr + 1, Len(CodP) - LTr)
Ws1.Cells(RR1, CC2).Value = NTag
Next RR2
RigaIni = RR1 + 1
End If
Next RR1
End Sub
Sub Trasponi()
Set ws1 = Worksheets("Foglio1")
ws1.Columns("B:IV").ClearContents
UR1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
RigaIni = 2
For RR1 = 2 To UR1
NT = ws1.Range("A" & RR1).Value
If (Len(Replace(Replace(NT, "-", ""), "-", "")) = Len(NT) - 1 Or Len(Replace(Replace(NT, "_", ""), "-", "")) = Len(NT) - 1) Or Len(Replace(NT, "-", "")) = Len(NT) Then
ws1.Range("B" & RR1).Value = NT
CC2 = 3
ws1.Cells(RR1, 3).Value = RR1 - RigaIni
For RR2 = RigaIni To RR1 - 1
CC2 = CC2 + 1
CodP = ws1.Range("A" & RR2).Value
LTr = InStrRev(CodP, "-")
NTag = Mid(CodP, LTr + 1, Len(CodP) - LTr)
ws1.Cells(RR1, CC2).Value = NTag
Next RR2
RigaIni = RR1 + 1
End If
Next RR1
End Sub
Torna a Applicazioni Office Windows
Formula per estrarre Stringa di testo da cella Autore: Omocaig |
Forum: Applicazioni Office Windows Risposte: 1 |
Visitano il forum: Marius44 e 25 ospiti