Application volatile et tableau, help ! :'(

[infogeo]

Salut !

J'avais un probleme avec mes tableaux croisés dynamiques pour sélectionner une plage alors du coup j ai transformé les plages en tableau et j'ai nommé ces tableaux.

ensuite dans la source de données du tableau dynamique, j'ai donc mis ce nom de tableau et ca marche niquel.

CEPENDANT


avant j’avais une fonction qui marchait bien et maintenant c plus le cas j ai fait le test avec la plage sous la forme d un tableau et sous forme "normale", sous forme normale la fonction marche mais quand la plage est sous forme d'un tableau non.

Cette fonction est une fonction volatile

ici:

Public Function compar(m1 As String, m2 As String, Optional k As Integer = 0) As Double

    Dim i As Integer
    Dim j As Integer
    Dim r As Integer
    
    Application.Volatile
    
    j = Len(m1): r = 0
    If Len(m2) > j Then j = Len(m2)
    
    For i = 1 To j
        If k = 1 Then
            If Mid(m1, i, 1) = Mid(m2, i, 1) Then r = r + 1
        Else
            If LCase(Mid(m1, i, 1)) = LCase(Mid(m2, i, 1)) Then r = r + 1
        End If
    Next i
    
    compar = r / j
    
End Function

elle est appelé comme ca:

 For i = 2 To nblignes
        Cells(i, colcomp1) = "=compar(RC[-1],R[-1]C[-1])"
        'Calculate
        Cells(i, colcomp1).Value = Cells(i, colcomp1).Value
        If Cells(i, colcomp2 - 1) <> "" And Cells(i - 1, colcomp2 - 1) <> "" Then
            Cells(i, colcomp2) = "=compar(RC[-1],R[-1]C[-1])"
            Cells(i, colcomp2).Value = Cells(i, colcomp2).Value
        End If
    Next i

Et en fait quand elle arrive à "End function" et bien au lieu de quitter la fonction et bien elle recommence ...... elle repart de "Public Function compar"


je ne vois pas pourquoi ..... en fait je ne sais pas exactement quels changement sont effectués quand on passe en mode tableau ....

Donc si vous auriez une idée et bah je suis preneur


Voila j espere que vous répondrez ^^


a+

 

[Paritec]

Re : Application volatile et tableau, help ! :'(

Bonjour
tu n'as pas un événementiel dans ta feuille?
du style Worksheet_Change ???
a+
papou

 

[infogeo]

Re : Application volatile et tableau, help ! :'(

merci de ta réponse !


humm ...

pour etre franc ca c'est un code que je dois reprendre de quelqu un (l'alternant qui était la avant moi) et le débugger/améliorer...

je vois pas trop ce que c'est un Worksheet_change ....

Mais faut bien qu'il soit codé et j'ai pas vu ça non .....

Et pis je t'ai mis le code ou se situe le problème .....

 

[infogeo]

Re : Application volatile et tableau, help ! :'(

une idée svp ?

 

[Paritec]

Re : Application volatile et tableau, help ! :'(

Re infogeo le forum
je te pose des questions tu me réponds "et pis j'ai mis le code", alors tu veux de l'aide et quand on t'en propose tu ne réponds pas!!
Joint ton fichier avec les explications dedans et on va y regarder
a+
papou

 

[infogeo]

Re : Application volatile et tableau, help ! :'(

salut!

Je suis désolé .... mais comme j ai dit je sais pas vraiment ce que c'est ....

Apres le fichier fait 230Mo ..... donc c chaud de le partager ^^ et jsais pas si j'ai vraiment le droit de partager les données, a mon avis non.

Voila pourquoi ... =)

Par contre je peux partager le code, ce que j ai fait.


Mais bon, j'ai transformé la plage de données en tableau car on m'avait conseillé de faire comme ca, puisque ensuite je peux mettre dans la source de données du tableau dynamique le nom du tableau et c'est réglé.

Mais bon mon problème au départ c'était ça: comment mettre dans la source de données d'un tableau dynamique, les données d'une sheet. Sachant que cette sheet peux être agrandit.
J'ai pas trouvé comment à part comme ca. En fait en gros c un : "ActiveSheet.usedRange.select" dont j'aurai besoin mais je peux pas mettre ca directement dans la source du tableau dynamique donc bon.
Est-ce que je peux le faire en VBA? je sais aps ....


Ici tout le code jusqu'à mon endroit ou ca coince en espérant que vous pourrez trouvé ce qui ne va pas

Sub new_functions()
    Call new_supyear
    Call new_supcol
    Call new_addyear
    Call new_keep
    Call new_compar2
    Call new_segment
    Call new_TDC_a_jour
End Sub


Sub new_supyear()

    Dim Year As Integer
    Dim GF As Integer
    Dim nblignes As Long
   
    Worksheets("new_allyear").Activate
    
    nblignes = Range("A1").End(xlDown).Row
      
    nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column

     
    For i = 1 To nbColonnes
        If Cells(1, i).Text = "Year" Then Year = i
        If Cells(1, i).Text = "Green Field" Then GF = i
    Next i
     
    
    Range(Cells(2, 1), Cells(nblignes, nbColonnes)).Select
    Selection.Sort Key1:=Cells(2, Year), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
    
    For i = nblignes To 2 Step -1
        If Cells(i, Year) = current_year - 1 Then
            stophere = i + 1
            i = 2
        End If
    Next i
    
    Rows(stophere & ":" & nblignes).Select
    Selection.Delete
    
'    Rows("1:1").Select
'    Selection.AutoFilter Field:=Year, Criteria1:="=" & current_year
'    ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select
'    Selection.Delete Shift:=xlUp
    
    Worksheets("new_allyear").AutoFilterMode = False
    
    If GF <> 0 Then
        Columns(GF).Select
        Selection.Delete Shift:=xlToRight
    End If


End Sub


Sub new_supcol()

    Worksheets("new_allyear").Activate
    nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
    
    Dim keep As Integer
    Dim Network As Integer
    Dim Group As Integer
    Dim Seg As Integer
    
    Dim keep2 As Integer
    Dim Network2 As Integer
    Dim Group2 As Integer
    Dim Seg2 As Integer


    For i = 1 To nbColonnes
        If Cells(1, i).Text = "Last_modified_order" Then keep = i
        If Cells(1, i).Text = "Network_size" Then Network = i
        If Cells(1, i).Text = "Group" Then Group = i
        If Cells(1, i).Text = "Segment" Then Seg = i
    Next i
    
    If Seg <> 0 Then
        Columns(Seg).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    If Group <> 0 Then
        Columns(Group).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    If Network <> 0 Then
        Columns(Network).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    If keep <> 0 Then
        Columns(keep).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    Worksheets(current_year).Select
    nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column
    

    For i = 1 To nbColonnes
        If Cells(1, i).Text = "Last_modified_order" Then keep2 = i
        If Cells(1, i).Text = "Network_size" Then Network2 = i
        If Cells(1, i).Text = "Group" Then Group2 = i
        If Cells(1, i).Text = "Segment" Then Seg2 = i
    Next i
    
    If Seg2 <> 0 Then
        Columns(Seg2).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    If Group2 <> 0 Then
        Columns(Group2).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    If Network2 <> 0 Then
        Columns(Network2).Select
        Selection.Delete Shift:=xlToLeft
    End If
    
    If keep2 <> 0 Then
        Columns(keep2).Select
        Selection.Delete Shift:=xlToLeft
    End If
    

End Sub


Sub new_addyear()

    Dim OT As Integer
    
    Worksheets(current_year).Select
    
    nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column

    For i = 1 To nbColonnes
        If Cells(1, i).Text = "000_offer_type" Then
            OT = i
            i = nbColonnes
        End If
    Next i


    
    Cells(1, 1).Select
    Selection.AutoFilter Field:=OT, Criteria1:="=0"
    
    ActiveSheet.UsedRange.Rows("2:" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.Copy
    
    Worksheets(current_year).AutoFilterMode = False
    
    Sheets("new_allyear").Select
    nblignes = Cells.Find("*", Range("A1"), , , xlByRows, xlPrevious).Row
    Cells(nblignes + 1, 1).Select
    ActiveSheet.Paste
   
End Sub


Sub new_keep()

    Dim nblignes As Long
    Dim ColOffer As Integer
 
    Worksheets("new_allyear").Activate
    
    nblignes = Range("A1").End(xlDown).Row
    nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column


    For i = 1 To nbColonnes
        If Cells(1, i).Text = "Offer" Then
            ColOffer = i
            i = nbColonnes
        End If
    Next i

    Cells(1, 1).Select
    Range(Cells(2, ColOffer), Cells(nblignes, nbColonnes)).Select
    Selection.Sort Key1:=Cells(2, ColOffer), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

    Columns("B:B").Select
    Selection.Insert Shift:=xlToRight
    Columns("I:I").Select
    Selection.Insert Shift:=xlToRight

    Cells(1, 9) = "Last_modified_order"

    For i = 2 To nblignes
        X = Cells(i, 1)
        Cells(i, 2) = Left(X, 9)
    Next i
        
    For i = 3 To nblignes
        Cells(i - 1, 9).NumberFormat = "0"
        If Cells(i - 1, 2) = Cells(i, 2) Then
            Cells(i - 1, 9) = "0"
        Else
            Cells(i - 1, 9) = "1"
        End If
    Next i
    
    Columns(9).Select
    Selection.NumberFormat = "General"
    Cells(nblignes, 9) = "1"
    Columns(9).Select
    Selection.NumberFormat = "General"
    Columns("B:B").Select
    Selection.Delete Shift:=xlToLeft

End Sub



Sub new_compar2()
'
' compar2 Macro
' Macro enregistrée le 20/10/2009 par adekerro
'
    Dim nblignes As Long
    Dim colName As Integer
    Dim colCust As Integer
    Dim colcomp1 As Integer
    Dim colcomp2 As Integer

    Worksheets("new_allyear").Activate

    nblignes = Range("A1").End(xlDown).Row
    nbColonnes = Cells.Find("*", Range("A1"), , , xlByColumns, xlPrevious).Column

    For i = 1 To nbColonnes
        If Cells(1, i).Text = "Name" Then colName = i
        If Cells(1, i).Text = "006_Form_Cust_name" Then colCust = i
    Next i

    Columns(colCust + 1).Insert (xlToRight)
    Cells(1, colCust + 1) = "compar2"
    Columns(colName + 1).Insert (xlToRight)
    Cells(1, colName + 1) = "compar1"

    For i = 1 To nbColonnes
        If Cells(1, i).Text = "compar2" Then colcomp2 = i
        If Cells(1, i).Text = "compar1" Then colcomp1 = i
    Next i


    'Columns(colName + 1).Select
    'Selection.Insert Shift:=xlToRight

    For i = 2 To nblignes
        Cells(i, colcomp1) = "=compar(RC[-1],R[-1]C[-1])"
        'Calculate
        Cells(i, colcomp1).Value = Cells(i, colcomp1).Value
        If Cells(i, colcomp2 - 1) <> "" And Cells(i - 1, colcomp2 - 1) <> "" Then
            Cells(i, colcomp2) = "=compar(RC[-1],R[-1]C[-1])"
            Cells(i, colcomp2).Value = Cells(i, colcomp2).Value
        End If
    Next i


End Sub

le fait de mettre sous forme d'un tableau est pratique car apres j ai juste a mettre le nom du tableau dans la source de données du tableau dynamique.
Mais s'il existe un autre moyen que de créer un tableau pour sélectionner toutes les cellules utilisées d'une sheet, je suis preneur, comme ca ma fonction marcherait correctement et j'aurais ma source pour le TCD



j'espere avoir été clair .... pas si évident ^^

Et j espere que vous pourrez m'aider