Modérateur: Vilains modOOs
N'oubliez pas que le terme "Macro" ou "OpenOffice"
Lisez ce fil pour savoir quelle balise utiliser
Vous avez illustré votre question avec des fichiers en provenance d'un site tiers
Global Valeur as Long,i as Long
Sub Main
Dim oDoc as Object, maFeuille as Object, oCurseur as Object, maZone as Object
Dim y as Long
oDoc = thisComponent
maFeuille = oDoc.CurrentController.ActiveSheet
oCurseur = maFeuille.createCursor
oCurseur.gotoEndOfUsedArea(False)
y = oCurseur.RangeAddress.EndRow
maZone = maFeuille.getCellRangeByPosition(1,0,1,y)
For i = UBound(maZone.DataArray) To 0 Step - 1
If i > 0 then
Valeur = maZone.dataArray(i - 1)(0)
If (maZone.dataArray(i)(0) - Valeur) > 100 Then
Trouver(maZone, maZone.dataArray(i)(0))
End If
End If
Next i
End Sub
Sub Trouver(Zone as Object,val)
Dim Cherche As Object, zSrc as Object, zDest as Object, maFeuille as Object
Dim trouv As Variant
Cherche = Zone.createSearchDescriptor
With Cherche
.SearchString = val
End With
trouv = Zone.findFirst(Cherche)
Zone.Rows.insertByIndex(trouv.CellAddress.Row,1)
maFeuille = thisComponent.CurrentController.ActiveSheet
zSrc = maFeuille.getCellRangeByPosition(trouv.CellAddress.Column -1,trouv.CellAddress.Row,trouv.CellAddress.Column,trouv.CellAddress.Row)
zDest = maFeuille.getCellRangeByPosition(trouv.CellAddress.Column -1,trouv.CellAddress.Row -1,trouv.CellAddress.Column,trouv.CellAddress.Row - 1)
zDest.DataArray = zSrc.DataArray
maFeuille.getCellByPosition(trouv.CellAddress.Column,trouv.CellAddress.Row - 1).Value = val - 100
End Sub
Sub CorrigerData()
Dim oDoc As Object, sh1 As Object, sh2 As Object
Dim zone As Object, Cible As Object
Dim zdata As Variant, zLigne As Variant
Dim x as integer,n as integer, DiffTemps as integer
Dim monTemps as date, monTempsSuivant as date
Dim LignesLouches(1000) As Integer
Dim AffLig As String
oDoc = ThisComponent
sh1 = oDoc.Sheets.getByName("Données XNet_Meteo")
sh2 = oDoc.Sheets.getByName("Correction des données")
zone = sh1.getCellRangeByName("Data")
zdata = zone.getDataArray
Dim zdata2((Ubound(zdata)+ 1000)) As Object
n=0
cplig = 0
On Error Goto ErrorHandler
for x = 0 to UBound(zdata) - 1
zdata2(n) = zdata(x)
rem monTemps = TimeValue(Format(zdata(x)(1),"00:00:00"))
rem monTempsSuivant = TimeValue(Format(zdata(x+1)(1),"00:00:00"))
rem DifTemps = DateDiff("s",monTemps,monTempsSuivant)
rem if DifTemps <> 60 and DifTemps<> -86340 then
monTemps = zdata(x)(1)
monTempsSuivant = zdata(x+1)(1)
DifTemps = monTempsSuivant - monTemps
if DifTemps <> 100 and DifTemps <> -235900 then
rem print x
LignesLouches(cplig) = x+2
cplig = cplig + 1
zligne = DuplicateArray(zdata(x))
zligne(1) = zligne(1) + 100
zdata2(n+1) = zligne
n=n+1
end if
n = n+1
next x
zdata2(n) = zdata(x)
For x=0 to cplig - 1
AffLig = Afflig + LignesLouches(x) + " "
sh1.getCellByPosition(1,LignesLouches(x)-1).CellBackColor = &HFFe7c6
Next x
print cplig & " Lignes louches :" & AffLig
redim preserve zdata2(n)
Cible = sh2.getCellRangeByPosition(0,1,Ubound(zdata(0)),n+1)
Cible.ClearContents(com.sun.star.sheet.CellFlags.VALUE + _
com.sun.star.sheet.CellFlags.DATETIME + _
com.sun.star.sheet.CellFlags.STRING)
Cible.setDataArray(zdata2)
Exit Sub
ErrorHandler:
print "Erreur à la ligne : " + x
End sub
Function DuplicateArray(Source)
Dim x as Integer
Dim Dupli(UBound(Source))
For x = 0 to Ubound(Source)
Dupli(x) = Source(x)
next x
DuplicateArray = Dupli
End Function
Jurassic Pork a écrit:hello,
1 - On copie toutes les données (plage nommée Data) de la feuille données (Données XNet-Meteo) dans une matrice (zdata) pour accélérer les traitements.
2 - On balaie les lignes dans la matrice
Option Explicit
Sub Main
Dim oSheet AS Object, oCursor AS Object, aDatas()
Dim nRow AS Long, nRowMax AS Long, nColMax AS Long, nDelta AS Long
oSheet = thisComponent.Sheets.getByName("Données XNet_Meteo")
oCursor = oSheet.createCursor : oCursor.gotoEndOfUsedArea(False)
nRowMax = oCursor.RangeAddress.EndRow
nColMax = oCursor.RangeAddress.EndColumn
aDatas = oSheet.getCellRangeByPosition(1, 0, 1, nRowMax).DataArray
FOR nRow = nRowMax TO 1 STEP -1
nDelta = oSheet.getCellByPosition(1, nRow).Value - oSheet.getCellByPosition(1, nRow-1).Value
IF nDelta > 100 AND nDelta <> 4100 THEN
oSheet.Rows.insertByIndex(nRow, 1)
oSheet.getCellRangeByPosition(0, nRow, nColMax , nRow).setDataArray(oSheet.getCellRangeByPosition(0, nRow+1, nColMax , nRow+1).DataArray)
oSheet.getCellByPosition(1, nRow).Value = oSheet.getCellByPosition(1, nRow+1).Value - 100
' Pour repérer l'insertion, activer la ligne suivante
' oSheet.getCellByPosition(1, nRow).CellBackColor = 16776960
nRow = nRow+1
ENDIF
NEXT nRow
End Sub
pour ton message d'erreur, lis ce tuto (jusqu'au bout) viewtopic.php?f=39&t=50996
ub Rétablir_LignesManquantes()
Dim lgn, n&, i&, j%, k%, t&, dt&
With Worksheets("Recuperation_des_donnees")
n = .Cells(.Rows.Count, 1).End(xlUp).Row
t = (.Cells(n, 2) \ 100) Mod 100 + (.Cells(n, 2) \ 10000) * 60
Application.ScreenUpdating = False
For i = n To 3 Step -1
t = (1440 + t - 1) Mod 1440
dt = (.Cells(i - 1, 2) \ 100) Mod 100 + (.Cells(i - 1, 2) \ 10000) * 60
If dt <> t Then
j = t - dt - 1: lgn = .Cells(i - 1, 1).Resize(, 62).Value
.Range(.Cells(i, 1), .Cells(i + j, 1)).EntireRow.Insert
For k = 0 To j
.Cells(i + k, 1).Resize(, 62).Value = lgn
.Cells(i + k, 2) = (((dt + k + 1) \ 60) * 100 + (dt + k + 1) Mod 60) * 100
Next k
t = dt
End If
Next i
End With
End Sub
La modération vous a écrit: 4 messages à la suite c'est 3 de trop.
Merci d'arrêter votre monologue. Vous disposez d'un bouton Éditer en haut à droite de chaque message et d'un autre bouton ajout si vous désirez ajouter un complément lorsqu'il n'y a pas de réponse.
guy8572 a écrit:il n'accepte les fichiers .csv que venant de "LibreOffice"
guy8572 a écrit:Les données récupérées par ce logiciel vont dans un fichier qui s'appelle : "Xnet_Meteo.csv
guy8572 a écrit:je formate la colonne B avec 6 chiffes
Dim oDoc As Object, sh1 As Object, sh2 As Object
Dim zone As Object, Cible As Object
Dim zdata As Variant, zLigne As Variant
Dim x as long,n as long, DiffTemps as long
Dim monTemps as date, monTempsSuivant as date
Dim LignesLouches(2000) As Long
Dim AffLig As String
oDoc = ThisComponent
sh1 = oDoc.Sheets.getByName("Données XNet_Meteo")
sh2 = oDoc.Sheets.getByName("Correction des données")
zone = sh1.getCellRangeByName("Data")
zdata = zone.getDataArray
Dim zdata2((Ubound(zdata)+ 2000)) As Object
Utilisateur(s) parcourant ce forum : Aucun utilisateur inscrit et 7 invité(s)