Moderatori: Anthony47, Flash30005
Sub EliminaTesto()
Area = "A1:IV100" '<<<<< Area di lavro che puoi modificare
For NN = 1 To 3 '<<<<< se le stringhe sono più di 3 modifica questo numero adattandolo
Select Case NN
Case 1
Nome = "message"
Case 2
Nome = "subject"
Case 3
Nome = "Quellochevuoi" '<<<<< altra stringa da personalizzare
End Select
With Range(Area)
Set C = .Find(Nome, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
C.ClearContents
Set C = .FindNext(C)
On Error Resume Next
Loop While Not C Is Nothing And C.Address <> firstAddress
On Error GoTo 0
End If
End With
Next NN
End Sub
UR = Range("E" & Rows.Count).End(xlUp).Row '<<<<< aggiungere
For RR = UR To 1 Step -1 '<<<<<<<<<<<<<<<<<<<<<<<< aggiungere
If Range("E" & RR).Value = "" Then Rows(RR).Delete '<<<<< aggiungere
Next RR '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<aggiungere
End Sub '<<<< esistente
Sub EliminaTesto2()
Area = "A1:IV100"
For NN = 1 To 3
Select Case NN
Case 1
Nome = "message"
Case 2
Nome = "subject"
Case 3
Nome = "Quellochevuoi"
End Select
With Range(Area)
Set C = .Find(Nome, LookIn:=xlValues)
If Not C Is Nothing Then
firstAddress = C.Address
Do
Riga = C.Row
Rows(Riga).ClearContents
Set C = .FindNext(C)
On Error Resume Next
Loop While Not C Is Nothing And C.Address <> firstAddress
On Error GoTo 0
End If
End With
Next NN
UR = Range("E" & Rows.Count).End(xlUp).Row
For RR = UR To 1 Step -1
If Range("E" & RR).Value = "" Then Rows(RR).Delete
Next RR
End Sub
Sub EliminaRighe()
UR = Range("E" & Rows.Count).End(xlUp).Row
For RR1 = UR To 2 Step -1
If UCase(Range("E" & RR1).Value) = "SUBJECT" Then
RigaU = RR1 - 1
For RR2 = RR1 - 1 To 1 Step -1
If UCase(Range("E" & RR2).Value) = "MESSAGE" Then
Rows(RR2 + 1 & ":" & RigaU).Delete
RR1 = RR2
GoTo saltaRR1
End If
Next RR2
End If
saltaRR1:
Next RR1
End Sub
Sub EliminaRighe()
UR = Range("D" & Rows.Count).End(xlUp).Row
For RR1 = UR To 2 Step -1
If UCase(Range("D" & RR1).Value) = "# MESSAGE: SUBJECT.JPG" Then
RigaU = RR1 - 1
For RR2 = RR1 - 1 To 1 Step -1
If UCase(Range("D" & RR2).Value) = "# MESSAGE: CROSS.JPG" Then
Rows(RR2 + 1 & ":" & RigaU).Delete
RR1 = RR2
GoTo saltaRR1
End If
Next RR2
End If
saltaRR1:
Next RR1
End Sub
Sub EliminaRighe2()
UR = Range("D" & Rows.Count).End(xlUp).Row
For RR1 = UR To 2 Step -1
If Mid(UCase(Range("D" & RR1).Value), 1, 18) = "# MESSAGE: SUBJECT" Then
RigaU = RR1 - 1
For RR2 = RR1 - 1 To 1 Step -1
If UCase(Range("D" & RR2).Value) = "# MESSAGE: CROSS.JPG" Then
Rows(RR2 + 1 & ":" & RigaU).Delete
RR1 = RR2
GoTo saltaRR1
End If
Next RR2
End If
saltaRR1:
Next RR1
End Sub
Flash30005 ha scritto:Perché se è come ho supposto nel messaggio precedente potresti usare questa macro
- Codice: Seleziona tutto
Sub EliminaRighe2()
UR = Range("D" & Rows.Count).End(xlUp).Row
For RR1 = UR To 2 Step -1
If Mid(UCase(Range("D" & RR1).Value), 1, 18) = "# MESSAGE: SUBJECT" Then
RigaU = RR1 - 1
For RR2 = RR1 - 1 To 1 Step -1
If UCase(Range("D" & RR2).Value) = "# MESSAGE: CROSS.JPG" Then
Rows(RR2 + 1 & ":" & RigaU).Delete
RR1 = RR2
GoTo saltaRR1
End If
Next RR2
End If
saltaRR1:
Next RR1
End Sub
Questa elimina dal primo Cross all'ultimo Subject (qualsiasi esso sia)
ciao
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Supporto per sviluppo macro VBA Ordinare per data Autore: Carletto Ribolla |
Forum: Applicazioni Office Windows Risposte: 3 |
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 |
Visitano il forum: Nessuno e 20 ospiti