Ma macro n'exécute pas une partie
Bonjour,
J'ai un problème avec ma macro elle n'exécute pas la partie 'Ajoute colonne pour calcul du volume' pourtant quand je regarde avec F8 il n'y pas de message d'erreur mais pourtant il ne m'affiche pas ce que je lui demande par contre quand je lance la macro dans un fichier Excel ou il y a juste une seule feuille ça fonctionne mais quand je rajoute une autre feuilles dans le fichier Excel ça ne fonctionne plus est j'ai besoin de la 2 ieme feuille évidemment
je peux pas mettre le fichier Excel car c'est un fichier qui est crée par un programme qui est SP3D
Mon code n'est pas parfait je sais me je débute en VBA
Merci
Sub VolHydroForWeight()
stepline = 4
Myfilexls = ActiveWorkbook.FullName
longueurnom = InStr(1, Myfilexls, ".")
Myfile = Left(Myfilexls, longueurnom - 1)
Mypath = ActiveWorkbook.Path
longueurpath = Len(Mypath)
mywin = Right(Myfilexls, (longueurnom - longueurpath + 2))
If ActiveSheet.Name <> "Sheet2" Then Exit Sub
Workbooks.Open Filename:="\\M5510\E_ingr\sp3d\spec\Dia-Sched.xls"
'reponse = Application.Dialogs(xlDialogOpen).Show
Windows(mywin).Activate
' affichage de toutes les lignes
Cells.Select
Selection.EntireRow.Hidden = False
' effacement des lignes dont la deuxième colonne est 'H'
nligne = 1
Range("A1").Select
lignefin = Application.ActiveCell.SpecialCells(xlLastCell).Row
Do While nligne < lignefin + 1
Seleinit = Cells(nligne, 2).Value
If Seleinit = "H" Then
Rows(nligne).Select
Selection.Delete
lignefin = lignefin - 1
Else
nligne = nligne + 1
End If
Loop
'Remplacement de la colonne alphanu des poids par une colonne numérique
Columns("I:I").Select
Selection.Copy
Columns("K:K").Select
ActiveSheet.Paste
Selection.Replace What:="kg", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Remise de kg dans l'entete et suppression de la colonne originale des poids
Range("K7").Select
ActiveCell.FormulaR1C1 = "kg"
Columns("K:K").Select
Application.CutCopyMode = False
Selection.Cut
Columns("I:I").Select
ActiveSheet.Paste
'Ajout de la somme totale des poids
Cells.Select
Range("D1").Activate
Selection.EntireColumn.Hidden = False
Columns("A:C").Select
Selection.Delete Shift:=xlToLeft
'suppression de l'entete
' Rows("2:7").Select
Rows("3:7").Select
Selection.Delete Shift:=xlUp
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Range("B3").Select
ActiveCell.FormulaR1C1 = "VOLUME HYDRO"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 20
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'Insertion d'une colonne
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
' Suppresion du mm dans la colonne longueur
pos = "E" & stepline
Range(pos).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Replace What:="mm", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
'Recalcul du nombre de ligne
pos = "C" & 1
Range(pos).Select
Selection.End(xlDown).Select
lastline = ActiveCell.Row
'Traitement des lignes ou la longueur est inférieure à 5 mm
' et arrondi de la valeur au 100 mm supérieur
nligne = 4
Range("A1").Select
Do While nligne < lastline + 1
longmm = Cells(nligne, 5).Value
If longmm < 5 Then
Rows(nligne & ":" & nligne).Select
Selection.Delete Shift:=xlUp
lastline = lastline - 1
Else
nligne = nligne + 1
End If
Loop
'selection de la zone à traiter
rangetraite = stepline & ":" & lastline
Rows(rangetraite).Select
'Tri sur la colonne C (code article complet)
pos = "C" & stepline
Selection.Sort Key1:=Range(pos), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
'placement de la fonction exact en colonne B et extension surles lignes significatives
pos = "B" & stepline
Range(pos).Select
ActiveCell.FormulaR1C1 = "=EXACT(RC[1],R[1]C[1])"
Range(pos).Select
rangetire = pos & ":B" & lastline
If lastline > stepline Then
Selection.AutoFill Destination:=Range(rangetire), Type:=xlFillDefault
End If
'positionnement sur la dernière ligne de la colonne B
positionstart = "B" & lastline
Range(positionstart).Select
GoTo jump
'Recherche des doublons via le code Vrai dans la colonne B
' et si doublon addition des quantité et supression d'une ligne
nrow = lastline
Do While nrow > stepline - 1
celvaleur = Cells(nrow, 2).Value
If celvaleur = "Faux" Then
nrow = nrow - 1
Else
val1 = Cells(nrow, "E").Value
val2 = Cells(nrow + 1, "E").Value
valsum = val1 + val2
posit = "E" & nrow
Range(posit).Select
ActiveCell.FormulaR1C1 = valsum
Rows(nrow + 1).Select
Selection.Delete
nblineefface = nblineefface + 1
nrow = nrow - 1
End If
Loop
'Effacement du contenu de la colonne B
Columns("B:B").Select
Selection.Clear
'décomposition du code en code famille et code article
nrow = stepline
Do While nrow < lastline - nblineefface + 1
poscel = "C" & nrow
Range(poscel).Select
Selection.NumberFormat = "@" ' format text pour la celulle
longcell = Len(ActiveCell)
longextrait = longcell - 4
famille = Left(ActiveCell, longextrait)
artid = Right(ActiveCell, 4)
ActiveCell.FormulaR1C1 = artid
poscel = "B" & nrow
Range(poscel).Select
ActiveCell.FormulaR1C1 = famille
nrow = nrow + 1
Loop
'Mise en page
jump:
lastline = lastline - nblineefface
'déplacement de la colonne des diamètres après le descriptif
Columns("A:A").Select
Selection.Cut
Columns("E:E").Select
Selection.Insert Shift:=xlToRight
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
'Ajoute colonne pour calcul du volume
Range("I" & stepline).Select 'ajout dans dernière colonne
ActiveCell.FormulaR1C1 = "=(LEFT(MID(RC[-6],FIND("","",RC[-6],1)+2,20),5))"
Range("I" & stepline).Select
If lastline > stepline Then
Selection.AutoFill Destination:=Range("I" & stepline & ":I" & lastline), Type:=xlFillSeries
End If
Range("I" & stepline & ":I" & lastline).Select
Selection.Copy
Range("J" & stepline).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:=",", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Selection.Cut
Range("I" & stepline).Select
ActiveSheet.Paste
Range("I3").Select
ActiveCell.FormulaR1C1 = "SCH"
Range("J" & stepline).Select
ActiveCell.FormulaR1C1 = "=concatenate(RC[-6],(RC[-1]))"
If lastline > stepline Then
Selection.AutoFill Destination:=Range("J" & stepline & ":J" & lastline), Type:=xlFillSeries
End If
Range("K" & stepline).Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],'[Dia-Sched.xls]Feuil1'!R2C3:R250C6,4,FALSE)" 'attention accepte 250 lignes dans dia-sched
If lastline > stepline Then
Selection.AutoFill Destination:=Range("K" & stepline & ":K" & lastline), Type:=xlFillSeries
End If
Range("L" & stepline).Select
ActiveCell.FormulaR1C1 = "=RC[-1]*RC[-7]/1000000000"
If lastline > stepline Then
Selection.AutoFill Destination:=Range("L" & stepline & ":L" & lastline), Type:=xlFillSeries
End If
Range("L" & lastline + 1).Select
Columns("L:L").Select
Selection.NumberFormat = "0.0000"
Range("F1").Select
Selection.Copy
Range("G1").Select
ActiveSheet.Paste
Range("B:E,G:G,L:L").Select
Range("L1").Activate
Selection.Copy
Sheets.Add.Name = "HYDRO"
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Rows("4:4").Select
Selection.Insert Shift:=xlDown
Range("A4").Select
ActiveCell.FormulaR1C1 = "Ident Code"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Description"
Range("C4").Select
ActiveCell.FormulaR1C1 = "DIA"
Range("D4").Select
ActiveCell.FormulaR1C1 = "Length (mm)"
Range("E4").Select
ActiveCell.FormulaR1C1 = "Weight (kg)"
Range("F4").Select
ActiveCell.FormulaR1C1 = "Vol (M³)"
Range("G4").Select
ActiveCell.FormulaR1C1 = "MAX LOAD (N)"
Range("A3").Select
ActiveCell.FormulaR1C1 = "VOLUME HYDRO"
With ActiveCell.Characters(Start:=1, Length:=12).Font
.Name = "Arial"
.FontStyle = "Gras"
.Size = 20
End With
Columns("A:G").EntireColumn.AutoFit
Rows("1:2").Select
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
End With
Range("A1:F2").Select
With Selection.Interior
.ColorIndex = 6 'couleur jaune pour titre
.Pattern = xlSolid
End With
' zonetr = "F" & lastline + 2
Range("F" & lastline + 2).Select
Selection.Font.Bold = True
With Selection.Interior
.ColorIndex = 43
.Pattern = xlSolid
End With
Range("A4:G4").Select
Selection.Font.Bold = True
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent1
.TintAndShade = 0.4
.PatternTintAndShade = 0
End With
With Selection
.HorizontalAlignment = xlCenter
End With
' Application.DisplayAlerts = False
' For Each sh In ThisWorkbook.Sheets
' If InStr(sh.Name, "SP3D") = 0 And InStr(sh.Name, "HYDRO") = 0 Then
' Sheets(sh.Name).Select
' ActiveWindow.SelectedSheets.Delete
' End If
' Application.DisplayAlerts = True
'Calcul du Max Load'
Range("G5").Select
ActiveCell.FormulaR1C1 = "=((NUMBERVALUE(RC[-2]))*10)+(RC[-1]*10000)"
Range("G5").Select
Selection.AutoFill Destination:=Range("G5:G25"), Type:=xlFillDefault
Range("G5:G25").Select
Range("G26").Select
ActiveCell.FormulaR1C1 = "=(SUM(R[-21]C:R[-1]C))+(SUM(R[-21]C:R[-1]C)/10)"
Selection.NumberFormat = "0.00"
'Supprimer les lignes en E et G où il y à zéro'
Dim Lig%
Application.ScreenUpdating = 0
For Lig = [E65536].End(xlUp).Row To 5 Step -1
If Range("E" & Lig).Value = 0 Then Rows(Lig).Delete
Next
Application.ScreenUpdating = 0
For Lig = [G65536].End(xlUp).Row To 5 Step -1
If Range("G" & Lig).Value = 0 Then Rows(Lig).Delete
Next
'Copie vers Sheet1'
Dim Ligne As Long
Ligne = Worksheets("Sheet1").Cells(Rows.Count, 7).End(xlUp).Row
Sheets("HYDRO").Range("G" & Rows.Count).End(xlUp).Copy
Sheets("Sheet1").Range("K8:K" & Ligne).PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
' Next
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete
On Error Resume Next
ActiveWorbook.Save
' ActiveWorkbook.SaveAs Filename:=nameworkb, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
Application.DisplayAlerts = False
' ActiveWorkbook.Saved = True 'Pour ne pas sauver l'original si un fichier hydro existe déjà et que l'on n'a pas voulu le remplacer
' ActiveWorkbook.Close
ActiveWorkbook.Close SaveChanges:=True
' Application.DisplayAlerts = False
sortie:
' ActiveWorkbook.Close ' pour fermer dia-sched
norun:
End SubBonjour,
j'ai besoin de la 2 ieme feuille évidemment
à tester,
If Sheets(2).Name <> "sheet2" Then Exit Sub Merci de ta réponse j'ai compris mon erreur c'est parce que comme tu as pu le remarque (ou pas) ca sert a calculer le volume mais ca fonctionne pas parce qu'à la colonne "I" il a des données qui sont en #valeur donc c'est pour ça qu'il ne calculer pas le volume il me reste plus qu'a supprimer c'est ligne ou il y a #valeur dans la colonne mais par contre je sais pas comment je pourrai code pour dire d'effacer quand il y a #Valeur mais sans effacer tout la ligne mais aussi sans remonter tout la ligne
re,
c'est difficile de te répondre sans voir le fichier Excel
bonjour
salut i20100 au passage
suggestion 1 :
mettre toutes les formules sur une seule feuille, inutile de les créer par macro
suggestion 2 :
coller les données sur une autre feuille spécialement destinée à cela
du coup tu as 2 feuilles, mais une seule avec des formules fixes, ou tu crées des TCD, GCD...
amitiés à tous
Oui je comprend voici un fichier Excel tout est explique dans l'Excel de ce que je veux obtenir je vais tout de même explique ici encore une fois ce que je veux c'est d'effacer ou il y a un zéro dans la plage de "I5:L10" effacer la ligne mais juste dans la plage pas ce qui est en dehors de la plage .
Merci
re
j'ai mis sous forme de Tableau ou Liste
puis un TCD, avec filtre "sur les valeurs" "différent de 0"
pas de VBA
amitiés
si je fais en vba c'est parce que mon programme qui importe les données ne prend en compte que le vba
quel est ton "programme qui importe et qui ne "prend en compte que VBA" ?
note : si tu veux "importer" des données dans Excel, provenant de fichiers divers (dont Excel ! ) il FAUT utiliser Power Query
https://www.youtube.com/watch?v=gwW2CDdvUUs
il est intégré aux versions actuelles d'Excel
il permet de pré-traiter les données lors de l'import
VBA est inutile
amitiés
C'est Smart 3D est c'est le programme lui même qui crée le fichier excel donc c'est pas possible d'utiliser le power query
C'est Smart 3D est c'est le programme lui même qui crée le fichier excel donc c'est pas possible d'utiliser le power query
mais si
PQuery lit toutes sortes de fichiers, dont les fichiers Excel
il FAUT apprendre un minimum de PQUery, c'est l'avenir d'Excel en particulier
essaye !
https://www.youtube.com/watch?v=gwW2CDdvUUs
amitiés
C'est Smart 3D est c'est le programme lui même qui crée le fichier excel donc c'est pas possible d'utiliser le power query
mais si
PQuery lit toutes sortes de fichiers, dont les fichiers Excel
il FAUT apprendre un minimum de PQUery, c'est l'avenir d'Excel en particulier
essaye !
https://www.youtube.com/watch?v=gwW2CDdvUUs
amitiés
J'aurai bien appris mais si je résous ce problème mon fichier sera fini et j'ai un délai pour finir le fichier si je dois tout recommencer depuis le début ca va prendre du temps mais merci de m'avoir montré un nouveau programme que je vais utiliser à l'avenir alors si c'est pour éviter d'utiliser vba ça me convient
alors on va faire comme tu as commencé :
- "importer" les données dans une feuille Import (grâce à VBA)
- ajouter des colonnes si nécessaire, contenant des formules
- faire un TCD comme je t'ai montré, pour trier/filtrer/faire des calculs de synthèes
- faire des GCD si tu veux
possible ?
Je vais essayer de filtre et de récupérer le code avec l'enregistrement macro
Bonjour Muntjact , jmd,
une début de piste,
pour la fonction Recherche,
=IFERROR(VLOOKUP(J7,'P:\sp3d\spec\[Dia-Sched.xls]Feuil1'!$C$2:$F$250,4,FALSE),0)
il faut chercher la valeur "3 inS-160 " sur un autre fichier ?
Sub Test()
Dim rw As Long, i As Long, v
With Sheets("test")
rw = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 5 To rw
If Not Application.CountIf(.Range("B" & i & ":E" & i), 0) > 0 Then
v = Split(.Range("B" & i), ",")
.Range("O" & i) = v(1)
.Range("P" & i) = .Range("C" & i) & v(1)
.Range("Q" & i) = x 'reste à déterminer la fonction de recherche
.Range("R" & i) = x 'reste à déterminer la fonction de recherche
End If
Next
End With
End SubOui c'est bien ça permet de recherche une valeur dans un fichier pour mon calcul
Je comprends pas pourquoi le code m'effacer que les cellules dans les lignes 6,7,8 dans la colonne k,L sûrement mal compris comment il valait déterminer la fonction de recherche
re,
à tester,
Sub Test()
Dim rw As Long, i As Long, v
With Sheets("test")
rw = .Cells(Rows.Count, 2).End(xlUp).Row
For i = 5 To rw
n = Application.CountIf(.Range("B" & i & ":E" & i), 0)
If Not Application.CountIf(.Range("B" & i & ":E" & i), 0) > 0 Then
v = Split(.Range("B" & i), ",")
.Range("O" & i) = v(1)
.Range("P" & i) = .Range("C" & i) & v(1)
wk = Workbooks("Dia-Sched.xls").Name
m = "" & Range("P" & i)
t = "VLOOKUP(""" & m & """,'[" & wk & "]Feuil1'!$C$2:$F$250,4,FALSE)"
r = Evaluate(t)
If IsError(r) Then
.Range("Q" & i) = "non trouvé"
Else
.Range("Q" & i) = r
.Range("R" & i) = (r * .Range("D" & i)) / 1000000000
End If
End If
Next
End With
End SubJ'ai un message d'erreur qui dit que " L'indice n'appartient pas à la sélection " à cette ligne ci
wk = Workbooks("Dia-Sched.xls").Name re,
j'ai supposé que le fichier est ouvert,
sinon, tu pourrais ajouter une requête dans ton fichier qui irait lire ce fichier