Moderatori: Anthony47, Flash30005
Se riesci gia' a fare questo non passarci i soli csv ma il workbook con i fogli gia' ordinati.Riesco a farli aprire e metterli in ordine.
Devi pero' passarci un link per accedere al file nel tuo fropbox!Ho aggiunto nella cartella dropbox il file "WorkBookOK". Ho aperto un log completo. Sono una trentina di csv.
Anthony47 ha scritto:Devi pero' passarci un link per accedere al file nel tuo fropbox!Ho aggiunto nella cartella dropbox il file "WorkBookOK". Ho aperto un log completo. Sono una trentina di csv.
Ciao
Anthony47 ha scritto:Ho guardato il file e vorrei una conferma...
Vedo che i fogli hanno (in C1) un time stamp non progressivo; mi confermi che, partendo dal foglio 4, i dati del foglio 5 sostituiscono quelli del foglio 4 (aggiornando cosi' il contenuto di foglio 4), i dati del foglio 6 sostituiscono anche loro quelli (aggiornati) del foglio 4, e cosi' via?
Ciao
Questo chiarisce molte cose.Vanno infatti uniti quelli con lo stesso valore nella cella E1. Alla fine avrò un solo foglio con WR=01 uno solo con WR=02 uno solo con WR=03 e così via.
Sub shmerge()
Dim I As Long, J As Long, myMatch, myMatch2, LastB As Long, myBeg As Single, myEnd As Single
Dim DelArr() As Long, myEndRow As Long
'
'Parte prima, merge dei dati
ReDim DelArr(1 To Worksheets.Count)
For J = 4 To Worksheets.Count
With Sheets(J)
Sheets(J).Tab.Color = RGB(0, 255, 0)
.Select
For I = J + 1 To Worksheets.Count
If Sheets(I).Range("E1") <> .Range("E1") Then Exit For
LastB = .Cells(Rows.Count, "B").End(xlUp).Row
If .Range("B3").Value = "" Then .Range("B3").Value = 0
myBeg = Sheets(I).Range("B4").Value
myEnd = Sheets(I).Range("B4").End(xlDown).Value
myEndRow = Sheets(I).Range("B4").End(xlDown).Row
myMatch = Application.Match(myBeg - 0.0001, .Range("B:B"))
myMatch2 = Application.Match(myEnd, .Range("B:B"))
If Not IsError(myMatch) Then
If IsError(myMatch2) Then myMatch2 = LastB
If myMatch <= myMatch2 Then
.Range(.Cells(myMatch + 1, 1), .Cells(myMatch2, 1)).Select
.Range(.Cells(myMatch + 1, 1), .Cells(myMatch2, 1)).EntireRow.Delete
.Cells(myMatch + 1, 1).Resize(myEndRow - 4 + 1, 1).EntireRow.Insert
Sheets(I).Range(Sheets(I).Range("B4"), Sheets(I).Range("B4").End(xlDown)).EntireRow.Copy _
Destination:=.Cells(myMatch + 1, 1)
DelArr(I) = I
Sheets(I).Tab.Color = RGB(255, 0, 0)
End If
End If
Next I
End With
J = I - 1
Next J
'Parte seconda
'Delete sheets:
Stop '*** VEDI TESTO
For I = UBound(DelArr, 1) To LBound(DelArr, 1) Step -1
If DelArr(I) = I Then
Application.DisplayAlerts = False
Sheets(I).Delete
Application.DisplayAlerts = True
End If
Next I
End Sub
Anthony47 ha scritto:Nella macro modifica
myBeg = Sheets(I).Range("B4").Value
in
myBeg = Application.WorksheetFunction.Min(Sheets(I).Range("B1:B50000").Value)
Ciao
Invece con quella modifica cosa ottieni?Scusa non mi sono spiegato bene... i valori anomali dovrebbe evitarli. In pratica non deve tenere conto dei valori superiori a 180
Anthony47 ha scritto:Invece con quella modifica cosa ottieni?Scusa non mi sono spiegato bene... i valori anomali dovrebbe evitarli. In pratica non deve tenere conto dei valori superiori a 180
myMatch2 = Application.Match(myEnd, .Range("B:B"))
'la prossima e' stata aggiunta:
mymatch3 = Application.Match(Round(myBeg - 0.000001, 2), Sheets(I).Range("B1:B50000"), 0)
If Not IsError(myMatch) Then
If IsError(myMatch2) Then myMatch2 = LastB
If myMatch <= myMatch2 Then
.Range(.Cells(myMatch + 1, 1), .Cells(myMatch2, 1)).Select
.Range(.Cells(myMatch + 1, 1), .Cells(myMatch2, 1)).EntireRow.Delete
'le prossime 2 sono state modificate:
.Cells(myMatch + 1, 1).Resize(myEndRow - mymatch3 + 1, 1).EntireRow.Insert
Sheets(I).Range(Sheets(I).Range("B1").Offset(mymatch3 - 1), Sheets(I).Range("B4").End(xlDown)).EntireRow.Copy _
Destination:=.Cells(myMatch + 1, 1)
DelArr(I) = I
Sheets(I).Tab.Color = RGB(255, 0, 0)
End If
End If
Next I
Torna a Applicazioni Office Windows
Macro modifica date scelta periodo Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 11 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
confrontare e evidenziare 2 fogli excel Autore: niccia |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 20 ospiti