Modification code

bonjour,

j'ai ce code et ces fichiers,pour bien voir de quoi je parles:

http://cjoint.com/13ju/CGypUek9gkv.htm

http://cjoint.com/13ju/CGypUzILuz0.htm

Sub ExporterActionsParCategories()

Dim fichier, t

Dim Wbk_Source As Workbook, Wbk_Cible As Workbook

Dim Wsh_Source As Worksheet

Dim Tbl_In(), Tbl_Temp()

Dim Plage As Range, Cel As Range

Dim i As Long, drlig As Long, fin As Long, cpt As Long, Pos As Long

Dim Colonne As String, maVar As String

t = Timer

'********** COLLECTE DES INFOS "Category" & "Action" *************

Set Wbk_Source = ThisWorkbook

'************************************************************************ A ADAPTER

'remplacer Feuil1 par le nom de la feuille contenant les category, actions etc.

Set Wsh_Source = Wbk_Source.Worksheets("Feuil1")

'**********************************************************************************FIN ADAPTATION

With Wsh_Source

drlig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row

fin = (drlig - 4) / 6

cpt = 0

ReDim Tbl_In(1 To 2, 1 To fin)

For i = 4 To drlig Step 6

cpt = cpt + 1

Tbl_In(1, cpt) = .Range("B" & i).Value

Tbl_In(2, cpt) = .Range("B" & i + 1).Value

Next i

End With

'************ FIN COLLECTE ****************************************

'************ OUVERTURE FICHIER CIBLE *****************************

MsgBox "Choix du fichier cible"

fichier = Application.GetOpenFilename

If VarType(fichier) = vbBoolean Then

MsgBox "Abandon opérateur", vbCritical, "Annulation"

Exit Sub

End If

Set Wbk_Cible = Workbooks.Open(fichier)

'************* Le fichier cible est ouvert ************************

'********** Choix de la colonne ou transférer les données *********

Set Plage = Application.InputBox("Sélectionner une seule cellule de la colonne ou vous voulez transférer les données", "Column choice", Type:=8)

If Not Plage Is Nothing And Plage.Count = 1 Then

Colonne = Split(Plage.Address(ColumnAbsolute:=False), "$")(0)

Else

MsgBox "Abandon opérateur", vbCritical, "Annulation"

Wbk_Cible.Close

Exit Sub

End If

'**************** FIN CHOIX COLONNE *******************************

'**************** Restitution des données *************************

Set Plage = Application.InputBox("Sélectionner la plage contenant les catégories", "Category", Type:=8)

If Plage Is Nothing Then

MsgBox "Abandon opérateur", vbCritical, "Annulation"

Wbk_Cible.Close

Exit Sub

Else

Application.ScreenUpdating = False

For Each Cel In Plage

For i = LBound(Tbl_In, 2) To UBound(Tbl_In, 2)

If Cel.Value Like "*" & "|---" & Tbl_In(1, i) & "*" Then Cells(Cel.Row, Colonne) = Tbl_In(2, i): Exit For

Next i

Next Cel

Application.ScreenUpdating = True

End If

'****************** FIN RESTITUTION ********************************

MsgBox "Exportation terminée en " & Timer - t & " secondes."

End Sub

j'ai deux problèmes avec ,

le premier c'est qu'il me retourne des cellules vides a certains endroits

le deuxieme est que j'aimerai que vous m'aidiez à le modifier pour qu'il fasse l'inverse de ce qu'il fait.

quelqu'un me l'a proposé, mais ca ne correspond pas a ce qu'on me demande de faire, et je ne viens tout juste de commencer a programmer, je suis débutante.

Bonsoir,

Dans ton fichier Source, tu as 938 lignes. Tu déclares "fin" comme entier long

drlig = .Columns(2).Find("*", , , , xlByColumns, xlPrevious).Row

fin = (drlig - 4) / 6

(938 -4)/6 n'est pas un nombre entier. Le résultat est 155,67

Comment t'assures-tu que les données source sont bien exportées dans la cible et dans les bonnes cellules?

Cdlt

slt,

on m'a propose ce code pour maider a avancer ds mn travail, perso j ny connais pas encore grand chose, si tu pouvais detailler et montrer des expl de ce que tu dis ce serait genial...

merci

Bonjour,

Tu trouveras ci-joint tes tes fichiers "cible" et "source" tous 2 modifiés.

Lances ta procédure normalement et vois les résultats dans le fichier "cible" en colonne J & K (pour l'exemple, car je crois que la colonne de destination est C).

Il y a un nombre de catégories plus important dans le fichier "source". Une mise à jour du fichier "cible" doit être effectuée, me semble-t-il. Il faudra alors être vigilant dans la saisie des noms de catégories (espace, majuscules, etc...)

Je ne doute pas que tu auras des questions, mais médites tout de même un peu

A te relire

nb : j'ai été amené à utiliser une fonction personnalisée pour m'assurer de l'égalité de certaines chaînes de caractères. Je joins le code pour les intéressés.

Option Explicit
Function TexteEpure(Texte As String) As String
Dim tempMot As String, tempCar As String
Dim i As Byte
' supprime tous les caractères AUTRES
' que "a à z","A à Z" ou chiffre et l'espace traditionnel.
' voir aide sur ASC et table de caractères ASCII.
    For i = 1 To Len(Texte)
        tempCar = Mid(Texte, i, 1)
        Select Case Asc(tempCar)
            Case 32 'espace traditionnel
            Case 48 To 57 'chiffre
            Case 65 To 90 'caractères A à Z
            Case 97 To 122 'caractères a à z
        Case Else
            tempCar = ""
        End Select
        tempMot = tempMot + tempCar
    Next i
    TexteEpure = tempMot
End Function

bonjour,

merci, je te dirai s'il y a quelque chose que je comprends pas

cordialement,