Sub Totaux() 'inspiré par un code de J. BOISGONTIER !!!
' no PIVOT TABLE no SUMPROD !
' Patrick
Application.ScreenUpdating = False
Dim Nb As Long
Dim Lun As Long, Mar, Mer, Jeu, Ven, Sam, Dima
Set f1 = Sheets("feuil1")
a = Range("table") ' zone de A2 à Ixxxx !!!!
Range("N2:W30").ClearContents ' FOR TESTING
Set Mondico1 = CreateObject("Scripting.Dictionary") ' ne garder qu'une occurence de chaque concaténation colonen A-B-C-D-E
Set mondico2 = CreateObject("Scripting.Dictionary") ' AJOUTER totaux colonne F-G-H
Set Mondico3 = CreateObject("Scripting.Dictionary")
Set Mondico4 = CreateObject("Scripting.Dictionary")
Set Mondico5 = CreateObject("Scripting.Dictionary")
Set Mondico6 = CreateObject("Scripting.Dictionary")
Set Mondico7 = CreateObject("Scripting.Dictionary")
Set Mondico8 = CreateObject("Scripting.Dictionary")
Set Mondico9 = CreateObject("Scripting.Dictionary")
Set Mondico10 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a)
temp = a(i, 1) & "\" & a(i, 2) 'concaténation avec un "\"
temp2 = a(i, 1) ' & "\" & a(i, 2)
Mondico1(temp) = Mondico1(temp) + a(i, UBound(a, 2)) '
'Debug.Print a(i, UBound(a, 2)), UBound(a, 1)
mondico2(temp) = mondico2(temp) + a(i, 3)
Mondico3(temp) = Mondico3(temp) + a(i, 4)
Mondico4(temp) = Mondico4(temp) + a(i, 5)
Mondico5(temp) = Mondico5(temp) + a(i, 6)
Mondico6(temp) = Mondico6(temp) + a(i, 7)
Mondico7(temp) = Mondico7(temp) + a(i, 8)
Mondico8(temp) = Mondico8(temp) + a(i, 9)
Mondico9(temp2) = Mondico9(temp2) + a(i, 3)
Mondico10(temp2) = Mondico10(temp2) + a(i, 3) + a(i, 4) + a(i, 5) + a(i, 7) + a(i, 8) + a(i, 9)
Lun = Lun + a(i, 3): Mar = Mar + a(i, 4): Mer = Mer + a(i, 5)
Jeu = Jeu + a(i, 6): Ven = Ven + a(i, 7): Sam = Sam + a(i, 8): Dima = Dima + a(i, 9)
Next
[N2].Resize(Mondico1.Count) = Application.Transpose(Mondico1.keys)
[n2:n1000].TextToColumns Destination:=Range("n2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="\"
[p2].Resize(mondico2.Count) = Application.Transpose(mondico2.items) '
[q2].Resize(Mondico3.Count) = Application.Transpose(Mondico3.items) '
[r2].Resize(Mondico4.Count) = Application.Transpose(Mondico4.items) '
[s2].Resize(Mondico5.Count) = Application.Transpose(Mondico5.items) '
[t2].Resize(Mondico6.Count) = Application.Transpose(Mondico6.items) '
[u2].Resize(Mondico7.Count) = Application.Transpose(Mondico7.items) '
[v2].Resize(Mondico8.Count) = Application.Transpose(Mondico8.items) '
' ????????????????
b = Mondico10.items
For i = 1 To UBound(b)
s = Split(b(i), "_")
Next
' ????????????????????????????????
Range("P" & [P65000].End(xlUp).Row + 1).Value = Lun
Range("Q" & [Q65000].End(xlUp).Row + 1).Value = Mar
Range("R" & [R65000].End(xlUp).Row + 1).Value = Mer
Range("S" & [S65000].End(xlUp).Row + 1).Value = Jeu
Range("T" & [T65000].End(xlUp).Row + 1).Value = Ven
Range("U" & [U65000].End(xlUp).Row + 1).Value = Sam
Range("V" & [V65000].End(xlUp).Row + 1).Value = Dima
[O15].Resize(Mondico9.Count) = Application.Transpose(Mondico9.keys) '
[P15].Value = "'? total here ! for personne 1 for Lundi-Mardi etc ..."
[P16].Value = "'???? total here for peronne 2"
' etc etc
' ????????????????????????????????
' ????????????????????????????????
'[P15].Value = s(0)
'[Q15].Value = s(1)
End Sub
Sub ToTessai()
a = Range("table") ' zone de A2 à Ixxxx !!!!
For i = 1 To UBound(a)
totp = totp + a(i, 3)
totq = totq + a(i, 4)
Next
Cells(14, 16) = totp
Cells(14, 17) = totq
End Sub
Sub SupDoublonsColAColBV3()
Application.ScreenUpdating = False
Set f1 = Sheets("BD")
a = f1.Range("A1").CurrentRegion.Value
Set mondico = CreateObject("Scripting.Dictionary")
Set mondico2 = CreateObject("Scripting.Dictionary")
Set Mondico3 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a)
temp = a(i, 1) & " / " & a(i, 2)
mondico(temp) = mondico(temp) + a(i, UBound(a, 2))
mondico2(temp) = a(i, 1)
Mondico3(temp) = a(i, 2)
Next
f1.[G1].Resize(mondico.Count) = Application.Transpose(mondico2.items)
f1.[H1].Resize(mondico.Count) = Application.Transpose(Mondico3.items)
f1.[I1].Resize(mondico.Count) = Application.Transpose(mondico.items)
End Sub