Eliminare range di righe ripetitivo

Anonimo

Un saluto a tutti.

vorrei poter eliminare da un file di testo importato in Excel (a sua volta convertito da un Pdf) un range di righe ripetitivo con una macro tranne il primo range che serve poi come intestazione.

A seconda del numero di pagine del Pdf il totale di range da cancellare varia dalle 150 a 200 unità

Allego un'immagine a supporto: ad esempio il primo range va da riga 77:87.

Mi auguro di essere stato chiaro. Grazie per la Vs attenzione.

Ciao Giovanni.

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Ciao Giovanni,

Interpretando la tua domanda in modo diverso da come ha fatto Mauro, e a patto che abbia capito bene io, prova:

'=========>>

Option Explicit

'--------->>

Public Sub DeleteRange()

Dim WB As Workbook

Dim SH As Worksheet

Dim Rng As Range, myRng As Range

Dim rCell As Range

Dim delRng As Range

Dim iLastRow As Long

Dim i As Long

Dim bDelete As Boolean

Dim CalcMode As Long

Const sStr As String = "Infopost-Manager" '<<==== Modifica

Const sFoglio As String = "Foglio1" '<<==== Modifica

Set WB = ThisWorkbook

Set SH = WB.Sheets(sFoglio)

With SH

iLastRow = LastRow(SH, .Columns("A:A"))

Set Rng = .Range("A2:A" & iLastRow)

End With

For i = 1 To Rng.Cells.Count

Set rCell = Rng.Cells(i)

With rCell

If CBool(InStr(1, .Value, sStr)) Then

Set myRng = .Offset(-1).Resize(11)

If bDelete Then

If delRng Is Nothing Then

Set delRng = myRng

Else

Set delRng = Union(myRng, delRng)

End If

i = i + 11

End If

bDelete = True

End If

End With

Next i

On Error GoTo XIT

With Application

CalcMode = .Calculation

.Calculation = xlCalculationManual

.ScreenUpdating = False

End With

If Not delRng Is Nothing Then

delRng.EntireRow.Delete

Else

'\ Niente trovato!

End If

XIT:

With Application

.Calculation = CalcMode

.ScreenUpdating = True

End With

End Sub

'--------->>

Function LastRow(SH As Worksheet, _

Optional Rng As Range)

If Rng Is Nothing Then

Set Rng = SH.Cells

End If

On Error Resume Next

LastRow = Rng.Find(What:="*", _

After:=Rng.Cells(1), _

Lookat:=xlPart, _

LookIn:=xlFormulas, _

SearchOrder:=xlByRows, _

SearchDirection:=xlPrevious, _

MatchCase:=False).Row

On Error GoTo 0

End Function

'<<=========

===

Regards,

Norman

0 commenti

Risposta accettata dall'autore della domanda

Anonimo

Un saluto a tutti.

vorrei poter eliminare da un file di testo importato in Excel (a sua volta convertito da un Pdf) un range di righe ripetitivo con una macro tranne il primo range che serve poi come intestazione.

Se il foglio si presenta tutto come dall'immagine (e se ho capito), puoi provare:

Public Sub m()

Dim sh As Worksheet

Dim rng As Range

Dim rRiga As Range

Dim lMax As Long

Dim lRiga As Long

Set sh = ThisWorkbook.Worksheets("Foglio1")

With sh

lRiga = .Range("A" & .Rows.Count).End(xlUp).Row

Set rng = .Range("A1:M" & lRiga)

lMax = Evaluate("=MAX(" & rng.Columns(1).Address & ")")

rng.Sort _

Key1:=.Range(rng.Address), _

Order1:=xlAscending, Header:=xlYes, _

OrderCustom:=1, MatchCase:=False, _

Orientation:=xlTopToBottom, _

DataOption1:=xlSortNormal

Set rRiga = .Range("A1:A" & lRiga).Find( _

What:=lMax, _

LookIn:=xlValues, _

LookAt:=xlWhole, _

SearchOrder:=xlRows, _

SearchDirection:=xlNext, _

MatchCase:=True)

.Rows(rRiga.Row + 1 & ":" & lRiga).Delete

End With

Set rRiga = Nothing

Set rng = Nothing

Set sh = Nothing

End Sub

Modifica la parte in grassetto con i tuoi riferimenti.

Modifica poi A1 con An, dove n è la riga successiva all'intestazione.

0 commenti

5 risposte aggiuntive

Anonimo

2015-02-26T21:51:21+00:00

Ciao Giovanni,

Può essere dovuto al fatto che ho modificato (Set Rng = .Range("A7:A" & iLastRow)?

Il file d'esempio è al seguente link: http://1drv.ms/1GxY1Hc

Il Foglio3 contiene i dati da strutturare

Foglio1 contiene la soluzione 1

Foglio2 contiene la soluzione 2

No, credo dipenda dal fatto che ho capito male io la tua esigenza! Pensavo che non volevi cancellare la prima istanza delle intestazioni. Per cancellare anche la prima istanza, sostituisci:

If CBool(InStr(1, .Value, sStr)) Then

Set myRng = .Offset(-1).Resize(11)

If bDelete Then

If delRng Is Nothing Then

Set delRng = myRng

Else

Set delRng = Union(myRng, delRng)

End If

i = i + 11

End If

bDelete = True

End If

con:

If CBool(InStr(1, .Value, sStr)) Then

Set myRng = .Offset(-1).Resize(11)

If delRng Is Nothing Then

Set delRng = myRng

Else

Set delRng = Union(myRng, delRng)

End If

i = i + 11

End If

End If

===

Regards,

Norman
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-02-26T20:15:26+00:00

Grazie anche Norman per la "soluzione 2"

Interpretato benissimo. L'unica "anomalia" è che non cancella le righe da 79 a 89. Mentre tutte le altre sì.

Può essere dovuto al fatto che ho modificato (Set Rng = .Range("A7:A" & iLastRow)?

Il file d'esempio è al seguente link: http://1drv.ms/1GxY1Hc

Il Foglio3 contiene i dati da strutturare

Foglio1 contiene la soluzione 1

Foglio2 contiene la soluzione 2

Grazie ancora

Ciao

Giovanni
La risposta è stata utile?

0 commenti Nessun commento
Anonimo

2015-02-26T20:07:24+00:00

Grazie per la risposta.

A cosa può essere dovuto il messaggio run-time 91 (.Rows(rRiga.Row + 1 & ":" & lRiga).Delete)?

Le righe da cancellare, dal momento che vengono spostate a fine range dati le posso cancellare manualmente in modo veloce.

Il file d'esempio è al seguente link: http://1drv.ms/1GxY1Hc

Il Foglio3 contiene i dati da strutturare

Foglio1 contiene la soluzione 1

Foglio2 contiene la soluzione 2

Grazie ancora.

Ciao Giovanni
La risposta è stata utile?

0 commenti Nessun commento