Alimentation automatique de bases des données
ça n'a rien changé, le problème est toujours là, sur la même ligne
peut-être c'est la difference MAC / PC
demain, je vais esseyer d'utiliser le "help" du Mac pour voir la difference entre le syntax du Mac par rapport ce du PC.
vba-new a écrit :Difficile de travailler à l'aveugle
Et comme ça ?
Range("C3:Z45").Sort Key1:=Range("C3"), Order1:=xlAscending, key2:=Range("D3"), Order2:=xlAscending(Sans le point au début)
vba-new
j'ai reçoie le message suivant:
Erreur d'exécution '1004'
La méthode 'Sort' de l'objet 'Range' a échoué
sur l'aide j'ai trouvé cet syntax /example
Worksheets(Sheet1) .Range("A1:C20") .Sort _
Key1:=Worksheets("Sheet1") .Range("A1") .Range("A1"), _
Key2:=Worksheets("Sheet1") .Range("B1")
est-ce que ça pourra aider?
merci,
Baton
-- 11 Aoû 2011, 14:00 --
vba-new,
c'est l'example d'aide:
Sort, méthode - Exemples
Cet exemple montre comment trier la plage A1:C20 de la feuille de calcul « Sheet1 », en utilisant la cellule A1 en tant que première clé de tri et la cellule B1 en tant que deuxième clé de tri. Le tri est effectué par ordre croissant par ligne et il n'y a pas d'en-tête.
Worksheets("Sheet1").Range("A1:C20").Sort _
Key1:=Worksheets("Sheet1").Range("A1"), _
Key2:=Worksheets("Sheet1").Range("B1")
Cet exemple montre comment trier la zone actuelle qui contient la cellule A1 de la feuille de calcul « Sheet1 », en triant les données de la première colonne et en utilisant automatiquement une ligne d'en-tête si nécessaire. La méthode Sort détermine automatiquement la zone en cours.
Worksheets("Sheet1").Range("A1").Sort _
Key1:=Worksheets("Sheet1").Columns("A"), _
Header:=xlGuess
Donc ça serait comme ça ?
ActiveSheet.Range("C3:Z45").Sort _
Key1:=ActiveSheet.Range("C3"), _
Key2:=ActiveSheet.Range("D3")vba-new a écrit :Donc ça serait comme ça ?
ActiveSheet.Range("C3:Z45").Sort _ Key1:=ActiveSheet.Range("C3"), _ Key2:=ActiveSheet.Range("D3")
J'ai essayé comme ça
Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet
ActiveSheet.Range("C3:Z45").Sort _
Key1:=ActiveSheet.Range("C3"), Order1:=xlAscending, _
Key2:=ActiveSheet.Range("D3"), Order2:=xlAscending
et comme ça
Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet.Range("C3:Z45").Sort _
Key1:=ActiveSheet.Range("C3"), Order1:=xlAscending, _
Key2:=ActiveSheet.Range("D3"), Order2:=xlAscending
et comme ça
Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet
ActiveSheet.Range("C3:Z45").Sort _
Key1:=ActiveSheet.Range("C3"), _
Key2:=ActiveSheet.Range("D3"),
et comme ça
Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
ActiveSheet.Range("C3:Z45").Sort _
Key1:=ActiveSheet.Range("C3"), Order1:=xlAscending, _
Key2:=ActiveSheet.Range("D3"), Order2:=xlAscending
il me semble que je fait qqc pas correctement parcz que toujours la première
Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
ligne reste jaune.
Bonjour Baton,
J'ai fait un fichier test. Si jamais ça marche pas, je fais une demande sur le forum.
Dans le fichier suivant, tu cliques sur le bouton de la feuille Commande. Si le tri se fait bien, tu devrais avoir le même résultat que la feuille "Resultat_attendu".
Bonjour vba-new,
Ca marche!!!
Mac a accepté le code sans problème.
CORDIALEMENT,
Baton
Ok. Il te reste à l'adapter à ton fichier.
Salut,
Depuis ce matin, j'essaie d"adapter" le code. Il y a du progress mais pas trop.
D'abord, il copie déjà le contenue d'une commande du fichier "Commande" dans le fichier "Data" (avant ça n'a jamais été fait).
Par contre, il reste pas mal des problèmes:
Dans ce cas-là, il me montre "Problème du syntax"
La première ligne et en jaune et les trois autres linges (bold) sont en rouge.
Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With Sheets("Commande")
.Range("C3:Z45").Sort _
Key1:=.Range("C3"), _
Key2:=.Range("D3")
End With
'ActiveSheet.Range("C3:Z45").Sort _
Key1:=ActiveSheet.Range("C3"), _
Key2:=ActiveSheet.Range("D3"),
nbLign = Application.CountIf(.[C3:C45], numEquip)
Set trouve = .Range("C2:C45").Find(numEquip, LookIn:=xlValues, LookAt:=xlWhole)
Set plageEquip = trouve.Resize(nbLign, 24)
Set ExistFichier = Nothing
On Error Resume Next
Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & " Model.xls")
On Error GoTo 0
If ExistFichier Is Nothing Then
MsgBox "L'équipe " & numEquip & " n'a pas de fichier." & vbCrLf & _
"Veuillez en créer un.", vbExclamation
Exit Sub
End If
J'ai essayé plusieurs variants mais sans success. Je n'ai pas pensé remplacer tout le SubCde_Equip par le code que marche dans le fichier test, parche le sort est seulement une partie de ce Sub. Est-ce que tu peux remplacer ce très grand Sub par plusieur où chaqu'un va faire une action/ opération?
Peut-être comme ça sera plus facile déboguer?
Merci,
Baton
Bonjour Baton,
Dans le fichier test, j'avais utilisé le nom de feuille "Commande".
Dans ton fichier réel, ce n'est pas Sheets("Commande") qu'il faut mettre mais Activesheet.
De plus, le End With du début doit être placé à la fin avant End Sub.
Ce serait trop compliqué.Baton a écrit :Est-ce que tu peux remplacer ce très grand Sub par plusieur où chaqu'un va faire une action/ opération?
Baton, ce que je te conseille maintenant c'est d'ouvrir si possible un autre post pour régler ton problème car je ne peux plus trop t'aider pour l'instant. Ne pas avoir de MAC sous la main rend très difficile la recherche d'une solution.
Bonsoir
La première ligne et en jaune et les trois autres linges (bold) sont en rouge.
C'est que tu as fait un copier coller depuis le forum
Place toi avant chaque instruction et supprime les espaces de manière à mettre tout sur la même ligne.
Le code de tri proposé par VBANEW le Mer Août 10, 2011 3:39 pm fonctionne très bien
Amicalement
Salut Dan,
J'ai aligné tous le code vers gauche. Mais
Peut être, le problème est le MAC....
Baton
re,
non ce n'est pas le MAC c'est ton code qu'il faut adapter légèrement
Colle le code complet ici que je vois et dis moi où le code s'arrête
Amicalement
Dan a écrit :re,
non ce n'est pas le MAC c'est ton code qu'il faut adapter légèrement
Colle le code complet ici que je vois et dis moi où le code s'arrête
Amicalement
C'est le code. Les 3 ligne "problematiques" sont en gros. Merci
Sub consolide()
Dim WbkMaitre As Workbook, WbkConso As Workbook
Dim nbLign As Long, derLign&, doublon&, i&, derLignC&, derLignA&
Dim TblCde
Dim repertoire As String
Dim cel As Range, trouve As Range
Application.ScreenUpdating = False
'classeur maître : Fichier contenant le bon de commande
Set WbkMaitre = ThisWorkbook
repertoire = "gestion:Dépenses:" 'mettre le chemin du répertoire contenant les BD ici, laisser le ":" à la fin
'If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire
'classeur cible 1 : Fichier de commandes consolidées
'ChDir repertoire
'Workbooks.Open repertoire & "BD consolidées.xls"
Workbooks.Open "gestion:Dépenses:BD consolidées.xls"
Set WbkConso = ActiveWorkbook
With WbkMaitre.Sheets("Commande")
'compte le nombre de ligne de commande
nbLign = .Application.WorksheetFunction.Count(.Range("C:C"))
'si le nombre de ligne est nul on sort de la macro
If nbLign = 0 Then MsgBox "La commande ne comporte aucune ligne": Exit Sub
Set TblCde = .[C3].Resize(nbLign, 24)
End With
With WbkConso
.Activate
With .Sheets("Data")
derLign = .Range("C" & Rows.Count).End(xlUp).Row + 1
.Range("C" & derLign).Resize(nbLign, 24).Value = TblCde.Value
TblCde.Copy
.Range("C" & derLign).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
'suppression des doublons
For Each cel In .Range("C" & derLign).Resize(nbLign)
doublon = Evaluate("SumProduct((" & .Range("C3:C" & derLign - 1).Address & "=" & cel.Value & ")*(" & .Range("D3:D" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
If doublon > 0 Then Cells(cel.Row, 1).Value = "$$$"
Next cel
Set trouve = .Range("A" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
If Not trouve Is Nothing Then
For i = nbLign + derLign - 1 To derLign Step -1
If .Cells(i, 1) = "$$$" Then .Rows(i).Delete
Next i
End If
derLignC = .Range("C" & Rows.Count).End(xlUp).Row
derLignA = IIf(.Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, .Range("A" & Rows.Count).End(xlUp).Row + 1)
If derLignC > derLignA Then
For i = derLignA To derLignC
.Cells(i, 1) = .Cells(i - 1, 1) + 1
Next i
End If
End With
'.Close
End With
With WbkMaitre
.Activate
a = .Sheets("Commande").Range("c3").Resize(nbLign).Value
lim = UBound(a)
ReDim temp(1 To lim, 1 To 1)
k = 1
cpt = 0
temp(1, 1) = a(1, 1)
For i = 1 To lim
For j = 1 To lim
If a(i, 1) = temp(j, 1) Then Exit For
cpt = cpt + 1
Next j
If cpt = lim Then k = k + 1: temp(k, 1) = a(i, 1)
cpt = 0
Next i
For i = 1 To k
Call Cde_Equip(WbkMaitre, .Sheets("Commande"), repertoire, temp(i, 1))
Next i
End With
End Sub
Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet
ActiveSheet.Range("C3:Z45").Sort _
Key1:=.Range("C3"), _
Key2:=.Range("D3")
With .Sort
.SetRange Range("C3:Z45")
.Orientation = xlTopToBottom
.Apply
End With
nbLign = Application.CountIf(.[C3:C45], numEquip)
Set trouve = .Range("C2:C45").Find(numEquip, LookIn:=xlValues, LookAt:=xlWhole)
Set plageEquip = trouve.Resize(nbLign, 24)
Set ExistFichier = Nothing
On Error Resume Next
Set ExistFichier = Workbooks.Open(rep & "BD d'équipe " & numEquip & " Model.xls")
On Error GoTo 0
If ExistFichier Is Nothing Then
MsgBox "L'équipe " & numEquip & " n'a pas de fichier." & vbCrLf & _
"Veuillez en créer un.", vbExclamation
Exit Sub
End If
Sheets("Data").Select
plageEquip.Copy
derLign = IIf(Range("C" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("C" & Rows.Count).End(xlUp).Row + 1)
With Cells(derLign, 3)
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
'suppression des doublons
Columns(3).Insert xlToRight
For Each cel In Range("D" & derLign).Resize(nbLign)
doublon = Evaluate("SumProduct((" & Range("D3:D" & derLign - 1).Address & "=" & cel.Value & ")*(" & Range("E3:E" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
If doublon > 0 Then Cells(cel.Row, 3).Value = "$$$"
Next cel
Set trouve = Range("C" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
If Not trouve Is Nothing Then
For i = nbLign + derLign - 1 To derLign Step -1
If Cells(i, 3) = "$$$" Then Rows(i).Delete
Next i
End If
Columns(3).Delete
derLignC = Range("C" & Rows.Count).End(xlUp).Row
derLignA = IIf(Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("A" & Rows.Count).End(xlUp).Row + 1)
If derLignC > derLignA Then
For i = derLignA To derLignC
Cells(i, 1) = Cells(i - 1, 1) + 1
Next i
End If
Application.DisplayAlerts = False
.Delete
End With
End Sub