Ciao Flash
tutto ok,grazie
la macro funziona benissimo,ed è molto veloce.
colgo l'occasione per ringraziare anche Ricky53
Moderatori: Anthony47, Flash30005
Option Explicit
Public UC As Single, UR As Single, E As Single, I As Single, R As Single
Sub EliminaCol_New()
Application.ScreenUpdating = False
Worksheets("Foglio1").Activate
UR = Worksheets("Foglio1").Range("A" & Rows.Count).End(xlUp).Row
For R = 1 To UR
UC = Worksheets("Foglio1").Range("IV" & UR).End(xlToLeft).Column
For I = 1 To UC
If Worksheets("Foglio1").Cells(R, I).Value <> "" Then
For E = I + 1 To UC
If Worksheets("Foglio1").Cells(R, I).Value = Worksheets("Foglio1").Cells(R, E).Value Then
Worksheets("Foglio1").Cells(R, E).Delete Shift:=xlToLeft
End If
Next E
If I = 20 Then
Worksheets("Foglio1").Range(Cells(R, 21), Cells(R, 30)).ClearContents
Exit For
End If
End If
Next I
Next R
Worksheets("Foglio1").Range("A1").Select
Application.ScreenUpdating = True
End Sub
ricky53 ha scritto:1. le variabili vanno sempre definite, per le numeriche preferibilmente evitare Integer (accetta come valore massimo 65536)
2. utilizzare sempre “option explicit” (controlla che le variabili siano state definite)
3. evitare “GoTo”
4. si può sostituire
Worksheets("Foglio1").Range("U" & R & ":IV" & R).Delete Shift:=xlToLeft
(cancella tutte le celle fino alla colonna “IV”: è eccessivo)
con
Worksheets("Foglio1").Range(Cells(R, 21), Cells(R, 30)).ClearContents
5. si possono anche eliminare le variabili di appoggio Valore e Valore2 utilizzando al posto di:
If Valore = Valore2 then
la seguente
if Worksheets("Foglio1").Cells(R, I).Value = Worksheets("Foglio1").Cells(R, e).Value then
2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
Sub primi20()
Application.ScreenUpdating = False
[AE1] = Timer
OutSh = "Foglio3" 'Foglio di Uscita
IRange = "A1:AD1" 'Colonne dati
LastR = Cells(Rows.Count, 1).End(xlUp).Row
For Each Cell In Range(IRange).Resize(LastR)
If Application.WorksheetFunction.CountIf(Range(Cells(Cell.Row, 1), Cell.Address), Cell.Value) < 2 Then
Cell.Copy Destination:=Sheets(OutSh).Cells(Cell.Row, 111).End(xlToLeft).Offset(0, 1)
End If
Next Cell
Sheets(OutSh).Range("V:AG").ClearContents
[AE2] = Timer
End Sub
Sheets(OutSh).Cells(Cell.Row, 111).End(xlToLeft).Offset(0, 1) = Cell.Value
Torna a Applicazioni Office Windows
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 6 |
formula excel non visualizza risultato Autore: tommasog |
Forum: Applicazioni Office Windows Risposte: 6 |
Excel 2016 - Funzione SCARTO + INDIRETTO Autore: pl1957 |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 56 ospiti