Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Controlla valori univoci e copia

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Controlla valori univoci e copia

Postdi BG66 » 27/10/22 11:57

Ciao a tutti.
In pratica vorrei:
a) controllare che i nomi presenti in AnagraficaFull" siano gli stessi presenti in "2022" (ovviamente il nome del foglio cambierà seguendo l'anno solare aggiungendosi al precedente) avvisandomi se trova dei mancanti;
b) se in "2022" mancano alcuni di questi, aggiungerli in fondo copiando le impostazioni dalle righe presenti (testo,linee,etc)

Ho abbozzato qualcosina per almeno visualizzare il dato:
Codice: Seleziona tutto
Sub Confronta_Colonne()
Dim Myarr(), Myarr1()
Dim rng As Range, Rng1 As Range
Dim ur As Long, Icount As Long
Dim Elephant As Variant

Application.ScreenUpdating = False
'Columns(3).ClearContents
ur = Foglio10.Range("E" & Rows.Count).End(xlUp).Row
Set rng = Range("E3:E" & ur)
Myarr() = rng
ur = Foglio12.Range("G" & Rows.Count).End(xlUp).Row
Set Rng1 = Range("G3:B" & ur)
ReDim Myarr1(1 To ur)
Icount = 1
For Each Elephant In Myarr
    If Application.WorksheetFunction.CountIf(Rng1, Elephant) = 0 Then
        ReDim Preserve Myarr1(1 To Icount)
        Myarr1(Icount) = Elephant
        Icount = Icount + 1
    End If
Next
If Icount = 1 Then
    MsgBox "Nessun dato trovato"
Else
    Foglio10.Range("z1:z" & Icount - 1).Value = Application.Transpose(Myarr1)
    Foglio10.Range("z:Z").RemoveDuplicates Columns:=1, Header:=xlNo
    MsgBox "Trovati " & Icount - 1 & " valori Univoci"
End If
Application.ScreenUpdating = True
End Sub


Grazie per l'aiuto
Gene
https://www.dropbox.com/scl/fi/n9hdf69srgbxn7eydicm7/Trova_assenti_forum.xlsm?dl=0&rlkey=f8b14a4ybgq51ykamm97rdmih
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 313
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: Controlla valori univoci e copia

Postdi Anthony47 » 27/10/22 15:40

Molte cose le hai lasciate alla nostra libera fantasia...
Con questa premessa ti propongo:
Codice: Seleziona tutto
Sub Confronta_e_Pareggia()
Dim AFRan As Range, Y20XX As Range
Dim URY As Long, URAF As Long
Dim yXXArr(), AFArr(), cMiss As Long, I As Long
'
URY = Foglio10.Cells(Rows.Count, "E").End(xlUp).Row
URAF = Foglio12.Cells(Rows.Count, "G").End(xlUp).Row
'
Set AFRan = Foglio12.Range("G3:G" & URAF)
Set Y20XX = Foglio10.Range("E3:E" & URY)
ReDim AFArr(1 To AFRan.Rows.Count, 1 To 1)
'
For I = 1 To AFRan.Rows.Count
    If Application.WorksheetFunction.CountIf(Y20XX, AFRan.Cells(I, 1)) = 0 Then
        AFArr(I, 1) = "M"
        cMiss = cMiss + 1
        Y20XX.Cells(Y20XX.Rows.Count + cMiss).Resize(1, 4).Value = AFRan.Cells(I, 1).Resize(1, 4).Value   '*** VEDI TESTO 1
    End If
Next I
If cMiss > 0 Then
    formatCopy = 13                                 '<<< Di quante colonne vanno copiate le formattazioni?? *** VEDI TESTO 2
    Y20XX.Cells(Y20XX.Rows.Count, 1).Resize(1, formatCopy).Copy
    Y20XX.Cells(Y20XX.Rows.Count + 1, 1).Resize(cMiss, formatCopy).PasteSpecial xlPasteFormats
    Application.CutCopyMode = False
    AFRan.Cells(1, 5).Resize(UBound(AFArr), 1) = AFArr              '*** VEDI TESTO 3
    MsgBox ("Mancanti (e aggiunti): " & cMiss)
Else
    MsgBox ("Completato, nessun mancante")
End If
End Sub

Questa:
-controlla se tutti i nominativi presenti in AnagraficaFull sono presenti in "2022"; se No li aggiunge in coda sull'elenco di "2022" copiando in tutto 4 colonne da AnagraficaFull a 2022 (vedi Testo 1)
-a fine controllo copia la formattazione di N colonne; ho impostato questo N a 13 (Vedi Testo 2)
-a fine controllo, su colonna K di AnagraficaFull scrive "M" accanto ai nominativi che in origine mancavano in 2022 (vedi Testo 3)

Le tre cose marcate "Vedi Testo x" me le sono inventate, perche' non le ho dedotte dal tuo messaggio

Vedi se puo' servire così...
Avatar utente
Anthony47
Moderatore
 
Post: 18602
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Controlla valori univoci e copia

Postdi BG66 » 28/10/22 04:38

[RISOLTO]
Ciao Anthony,
ovviamente è ok e le tue integrazioni sono gradite sempre e comunque.

Grazie come al solito.

Buon ponte... se te lo concedi!! :lol:
Gene
BG66
Excel2010
Avatar utente
BG66
Utente Senior
 
Post: 313
Iscritto il: 20/08/16 07:44


Torna a Applicazioni Office Windows


Topic correlati a "Controlla valori univoci e copia":


Chi c’è in linea

Visitano il forum: Nessuno e 5 ospiti