Moderatori: Anthony47, Flash30005
Sub cros()
Dim OldC As String, ChainA As String, ChainB As String, I As Long, NextR As Long
'
Sheets("SNP").Select
OldC = "": ChainA = "": ChainB = ""
Sheets("RIEP").Cells.ClearContents
Range("A1:O1").Copy Sheets("RIEP").Range("A1")
'
For I = 2 To Cells(Rows.Count, 3).End(xlUp).Row
If OldC = "" Then OldC = Cells(I, 3).Value
If Cells(I, 3).Value = OldC Then
ChainA = ChainA & ";" & Cells(I, 1)
ChainB = ChainB & ";" & Cells(I, 2)
Else
With Sheets("RIEP")
NextR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(NextR, 1) = Mid(ChainA, 2, 9999)
.Cells(NextR, 2) = Mid(ChainB, 2, 9999)
.Cells(NextR, 3) = OldC
.Cells(NextR, 4).Resize(1, 9).Value = Cells(I - 1, 4).Resize(1, 9).Value
OldC = Cells(I, 3): ChainA = "": ChainB = ""
I = I - 1
End With
End If
Next I
End Sub
Sub cros2()
Dim OldC As String, ChainA As String, ChainB As String, I As Long, NextR As Long
'
Sheets("SNP").Select
OldC = "": ChainA = "": ChainB = ""
Sheets("RIEP").Cells.ClearContents
Range("A1:O1").Copy Sheets("RIEP").Range("A1")
'
For I = 2 To Cells(Rows.Count, 3).End(xlUp).Row + 1
If OldC = "" Then OldC = Cells(I, 3).Value
If Cells(I, 3).Value = OldC Then
ChainA = ChainA & ";" & Cells(I, 1)
ChainB = ChainB & ";" & Cells(I, 2)
Else
With Sheets("RIEP")
NextR = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(NextR, 1) = Mid(ChainA, 2, 99999)
.Cells(NextR, 2) = Mid(ChainB, 2, 99999)
.Cells(NextR, 3) = OldC
.Cells(NextR, 4).Resize(1, 9).Value = Cells(I - 1, 4).Resize(1, 9).Value
OldC = Cells(I, 3): ChainA = "": ChainB = ""
I = I - 1
End With
End If
Next I
End Sub
Torna a Applicazioni Office Windows
Ordinare colonne sulla stessa riga se stesso contenuto Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 10 |
Mettere tutto MAIUSCOLO un range di celle Autore: raimea |
Forum: Applicazioni Office Windows Risposte: 7 |
Trasformare celle con formattazioni in html Autore: servicedynergy |
Forum: Applicazioni Office Windows Risposte: 5 |
Stabilire righe e colonne da mostrare a schermo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 10 |
Visitano il forum: Nessuno e 29 ospiti