Moderatori: Anthony47, Flash30005
Option Explicit
Option Base 1
Sub Elimina_Colonne_Uguali()
Dim Vett_A(), Vett_B(), Vett_C()
Dim I As Integer, J As Integer, K As Integer, Uguali As Integer, Inizio As Long
Dim Ws1 As Worksheet, Ws2 As Worksheet, Sh As Integer, Sh_A As Integer, Messaggio As String, Cancellate As Integer
ReDim Vett_C(37, 37)
Application.ScreenUpdating = False
Inizio = Timer
Cancellate = 0: Messaggio = ""
For Sh_A = 1 To Worksheets.Count
Set Ws1 = Sheets(Sh_A)
Vett_A = Ws1.Range("B2:AL38")
' Traspone la Matrice
For I = 1 To 37
For J = 1 To 37
Vett_C(J, I) = Vett_A(I, J)
Next J
Next I
Vett_A = Vett_C
For Sh = Sh_A + 1 To Worksheets.Count
ReDim Vett_C(37, 37)
Set Ws2 = Sheets(Sh)
Vett_B = Ws2.Range("B2:AL38")
' Traspone la Matrice
For I = 1 To 37
For J = 1 To 37
Vett_C(J, I) = Vett_B(I, J)
Next J
Next I
Vett_B = Vett_C
For I = 37 To 1 Step -1 ' Scorre le colonne della Matrice
For K = 37 To 1 Step -1
Uguali = 0
For J = 1 To 37 ' Scorre le righe della Matrice
If Vett_A(I, J) = Vett_B(K, J) Then
Uguali = Uguali + 1
End If
Next J
If Uguali = 37 Then
'...................................................................................
' Togli l'apice alla seguente istruzione per cancellare effettivamente le colonne
' Columns(K + 1).Delete
'...................................................................................
Messaggio = Messaggio & vbCrLf & vbCrLf & "Cancellata la colonna " & K & " del Foglio " & Sh _
& " che è uguale alla colonna " & I & " del Foglio " & Sh_A
Cancellate = Cancellate + 1
End If
Next K
Next I
Next Sh
Next Sh_A
Application.ScreenUpdating = True
If Cancellate > 0 Then
Messaggio = Messaggio & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "In totale sono state cancellate " & Cancellate & " colonne impiegando (h.mm.ss) " & Format((Timer - Inizio) / 1440, "h.mm.ss")
Else
Messaggio = "NON sono state cancellate colonne"
End If
MsgBox Messaggio
Set Ws1 = Nothing: Set Ws2 = Nothing
End Sub
' Columns(K + 1).Delete
Sheets(Sh).Columns(K + 1).Delete
Columns(K + 1).Delete
Torna a Applicazioni Office Windows
Ordinare colonne sulla stessa riga se stesso contenuto Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 10 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
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 14 ospiti