Unisci date riportate su 2 colonne

Question

Ciao a tutti,

Ho bisogno del vostro aiuto per capire quale formula utilizzare per copiare le date scritte sul foglio2 nelle colonne A e F. Ho la necessità di riportare nel Foglio1 nella colonna A le date dalla minore alla maggiore. Bisogna anche tener conto che potrebbero esserci dei mesi che nella colonna F non ci saranno date. Per rendere più chiara la mia richiesta, allego un file che trovate qui

Answer 1

Ciao Geacs,

Il codice che avevo pubblicato mancava la funzione SortedUniqueList e quindi il codice avrebbe dovuto essere:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim srcSH As Worksheet, destSH As Worksheet 

Dim Rng1 As Range, Rng2 As Range, destRng As Range, rCell As Range 

Dim vArr() As Variant 

Dim LRow As Long, UB As Long 

Dim i As Long, iCtr As Long 

Const sFoglio\_Sorgente As String = **"Foglio2"** 

Const sFoglio\_Destinazione As String = **"Foglio1"** 

With ThisWorkbook 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

With srcSH 

    LRow = .Range("A1").End(xlDown).Row 

    Set Rng1 = .Range("A2:A" & LRow) 

    Set Rng2 = .Range("F6:F8") 

End With 

vArr = Application.Transpose(Rng1.Value2) 

UB = UBound(vArr) 

For Each rCell In Rng2.Cells 

    With rCell 

        If IsDate(.Value) Then 

            iCtr = iCtr + 1 

            ReDim Preserve vArr(1 To UB + iCtr) 

            vArr(UB + iCtr) = CLng(rCell.Value) 

        End If 

    End With 

Next rCell 

vArr = Application.Transpose(vArr) 

vArr = SortedUniqueList(vArr) 

Set destRng = destSH.Range("A4") 

With destRng.Resize(UBound(vArr)) 

    .Value = Application.Transpose(vArr) 

    .NumberFormat = "dd/mm/yyy" 

End With 

End Sub

'-------->>

Public Function SortedUniqueList(V As Variant)

Dim oSortedUniqueList As Object 

Dim arrOut() As Variant 

Dim sStr As String 

Dim i As Long 

Set oSortedUniqueList = CreateObject("System.Collections.Sortedlist") 

With oSortedUniqueList 

    For i = LBound(V) To UBound(V) 

        sStr = V(i, 1) 

                    If Not sStr = vbNullString Then 

                        If Not .ContainsKey(sStr) Then 

        .Add Key:=sStr, Value:=i 

                        End If 

                    End If 

    Next i 

    ReDim arrOut(1 To .Count) 

    For i = 0 To .Count - 1 

        arrOut(i + 1) = .GetKey(i) 

    Next i 

End With 

SortedUniqueList = arrOut 

End Function

'<<========

===

Regards,

Norman

Answer 2

Ciao a tutti,

Ho bisogno del vostro aiuto per capire quale formula utilizzare per copiare le date scritte sul foglio2 nelle colonne A e F. Ho la necessità di riportare nel Foglio1 nella colonna A le date dalla minore alla maggiore. Bisogna anche tener conto che potrebbero esserci dei mesi che nella colonna F non ci saranno date. Per rendere più chiara la mia richiesta, allego un file che trovate qui

Se cerchi una formula, sempre che tu abbia una versione di Excel recente, puoi usare:

=LET(D;DATI.ORDINA(UNICI(STACK.VERT(Foglio2!A2:A900;Foglio2!F6:F800)));FILTRO(D;D))

Ciao.

Answer 3

Ciao Geacs,

Inutile dire che il codice fa esattamente quello che ho chiesto. Solo un dettaglio mi è sfuggito.

Nella colonna F potrebbe succedere che venga riportata una data che si trova anche nella colonna A.

In questo caso, potresti fare in modo che non venga aggiunta 2 volte la stessa data nella colonna A del Foglio1 quando eseguo il codice?.

Sostituisci il mio codice precedente con la seguente versione:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim srcSH As Worksheet, destSH As Worksheet 

Dim Rng1 As Range, Rng2 As Range, destRng As Range, rCell As Range 

Dim vArr() As Variant 

Dim LRow As Long, UB As Long 

Dim i As Long, iCtr As Long 

Const sFoglio\_Sorgente As String = **"Foglio2"** 

Const sFoglio\_Destinazione As String = **"Foglio1"** 

With ThisWorkbook 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

With srcSH 

    LRow = .Range("A1").End(xlDown).Row 

    Set Rng1 = .Range("A2:A" & LRow) 

    Set Rng2 = .Range("F6:F8") 

End With 

vArr = Application.Transpose(Rng1.Value2) 

UB = UBound(vArr) 

For Each rCell In Rng2.Cells 

    With rCell 

        If IsDate(.Value) Then 

            iCtr = iCtr + 1 

            ReDim Preserve vArr(1 To UB + iCtr) 

            vArr(UB + iCtr) = CLng(rCell.Value) 

        End If 

    End With 

Next rCell 

vArr = Application.Transpose(vArr) 

vArr = SortedUniqueList(vArr) 

Set destRng = destSH.Range("A4") 

With destRng.Resize(UBound(vArr)) 

    .Value = Application.Transpose(vArr) 

    .NumberFormat = "dd/mm/yyy" 

End With 

End Sub

'<<========

Ho aggiornato il mio file di prova Geacs20221205.xlsm

===

Regards,

Norman

Answer 4

Ciao Norman,

Inutile dire che il codice fa esattamente quello che ho chiesto. Solo un dettaglio mi è sfuggito.

Nella colonna F potrebbe succedere che venga riportata una data che si trova anche nella colonna A.

In questo caso, potresti fare in modo che non venga aggiunta 2 volte la stessa data nella colonna A del Foglio1 quando eseguo il codice?

Grazie come sempre per il tuo aiuto.

Answer 5

Ciao Geacs,

Ho bisogno del vostro aiuto per capire quale formula utilizzare per copiare le date scritte sul foglio2 nelle colonne A e F. Ho la necessità di riportare nel Foglio1 nella colonna A le date dalla minore alla maggiore. Bisogna anche tener conto che potrebbero esserci dei mesi che nella colonna F non ci saranno date. Per rendere più chiara la mia richiesta, allego un file che trovate qui

Prova qualcosa del genere:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim srcSH As Worksheet, destSH As Worksheet 

Dim Rng1 As Range, Rng2 As Range, destRng As Range, rCell As Range 

Dim vArr() As Variant 

Dim LRow As Long, UB As Long 

Dim i As Long, iCtr As Long 

Const sFoglio\_Sorgente As String = "Foglio2" 

Const sFoglio\_Destinazione As String = "Foglio1" 

With ThisWorkbook 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

    Set destSH = .Sheets(sFoglio\_Destinazione) 

End With 

With srcSH 

    LRow = .Range("A1").End(xlDown).Row 

    Set Rng1 = .Range("A2:A" & LRow) 

    Set Rng2 = .Range("F6:F8") 

End With 

vArr = Application.Transpose(Rng1.Value2) 

UB = UBound(vArr) 

For Each rCell In Rng2.Cells 

    With rCell 

        If IsDate(.Value) Then 

            iCtr = iCtr + 1 

            ReDim Preserve vArr(1 To UB + iCtr) 

            vArr(UB + iCtr) = CLng(rCell.Value) 

        End If 

    End With 

Next rCell 

vArr = Application.Transpose(vArr)

' vArr = Application.Sort(vArr)

vArr = Sorted_Array(vArr, 1)

Set destRng = destSH.Range("A4") 

With destRng.Resize(UBound(vArr)) 

    .Value = vArr 

    .NumberFormat = "dd/mm/yyy" 

End With 

End Sub

'-------->>

Public Function Sorted_Array(arrIn, Sort_col As Long) As Variant

Dim arrList As Object 

Dim arrOut As Variant, myArr As Variant 

Dim j As Long, jj As Long, k As Long 

Set arrList = CreateObject("System.Collections.Arraylist") 

With arrList 

    For j = 1 To UBound(arrIn) 

        .Add arrIn(j, Sort\_col) 

    Next 

    .Sort 

    arrOut = .ToArray 

    .Clear 

    For j = 0 To UBound(arrOut) 

        For jj = 1 To UBound(arrIn) 

            If arrIn(jj, Sort\_col) = arrOut(j) Then 

                .Add Application.Index(arrIn, jj) 

                arrIn(jj, Sort\_col) = "" 

                Exit For 

            End If 

        Next jj 

    Next j 

    ReDim myArr(1 To UBound(arrIn), 1 To UBound(arrIn, 2)) 

    For j = 0 To .Count - 1 

        For k = 1 To UBound(arrIn, 2) 

            myArr(j + 1, k) = arrList.Item(j)(k) 

        Next k 

    Next j 

End With 

Sorted\_Array = myArr 

End Function

'<<========

Potresti scaricare il mio file di prova Geacs20221205.xlsm

===

Regards,

Norman