Discussion :

[gabi974]

Bonjour,

Mon problème est que je dois copier le résultat de plusieurs cellules appartenant à un même groupe, définis pas une cellule fusionné à leur gauche.

Ce qui fait la spécificité de mon problème est je dois copier des valeurs en Hexadecimal du bit le plus fort au bit le plus faible. Sur mon tableur, il part du bas vers le haut (sur la colonne "C" pour l'exemple ).

Je veux donc écrire sur mon fichier .txt, sur la même ligne, les valeurs hexa du bit le plus fort au plus faible (du bas jusqu'en haut), dans la condision où ma cellule de groupe est fusionné(colonne "B").

Si la condition ne marche pas, je peux utiliser: si la cellule suivante en "B" = cellule actuel "B", alors j'écris mes valeurs à la suite de la dernière colonne du groupe en "C" jusqu'à la première cellule du groupe en "C".

Merci de votre compréhension,

Gabi974

Edit:

Bonjour, je n'ai malheureusement pas de réponse, peut être que j'ai mal écrit, je reformule mon problème:

Je souhaite copier bout à bout des valeurs dans une colonne (en hexa) pour les coller sur une même ligne.(colonne C)
La difficulté est qu'il faut copier du bas vers le haut dans la condition qu'il y ai la même valeur sur la colonne de gauche.(colonne B)

Merci,

gabi974

edit:
Désolé, je up.

[Invité]

Bonjour,

Ci-joint, un code correspondant à ce que j'ai compris de votre problème et qui est indépendant des valeurs hexadécimales se trouvant dans la colonne C. L'important étant de savoir qu'il faut transposer à partir de la fin pour chaque cellule non vide dans la colonne B.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Option Explicit
 
Sub RegrouperLesMesuresSurUneLigne()
 
Dim ShMesures As Worksheet
Dim AireMesures As Range
Dim CelluleMesure As Range
Dim AireDesCellulesHexa As Range
 
Dim DerniereLigne As Long
Dim I As Long
Dim J As Long
 
        Set ShMesures = Sheets("Feuil1")
        With ShMesures
 
            .Range(.Cells(1, 4), .Cells(.UsedRange.Rows.Count, .Columns.Count)).Clear
 
            DerniereLigne = .Cells(.Rows.Count, 2).End(xlUp).Row
 
            Set AireMesures = .Range(.Cells(1, 2), .Cells(DerniereLigne, 2))
 
            For Each CelluleMesure In AireMesures
                If CelluleMesure <> "" Then
                   If CelluleMesure.MergeCells = True Then
                      Set AireDesCellulesHexa = CelluleMesure.MergeArea
                      J = 0
                      For I = AireDesCellulesHexa.Count To 1 Step -1
                            CelluleMesure.Offset(0, 2 + J) = AireDesCellulesHexa.Cells(I, 1).Offset(0, 1)
                            J = J + 1
                      Next I
                      Set AireDesCellulesHexa = Nothing
                   Else
                      CelluleMesure.Offset(0, 2) = CelluleMesure.Offset(0, 1)
                   End If
                End If
            Next CelluleMesure
            Set AireMesures = Nothing
        End With
 
        Set ShMesures = Nothing
 
End Sub

Pièce jointe 175855

Cordialement.

[gabi974]

Bonjour Eric KERGRESSE,

Merci pour ta réponse, elle est correct, mais j'essai de l'adapter à mon cas:

Depuis le début de ma programmation, j'utilise les range("B"...);
La résultat est sur une ligne d'un fichier de format txt.

Je vais analyser ton code, si ça marche pour mon cas, je résolve le sujet.

cordialment,

gabi974

[Invité]

mais j'essai de l'adapter à mon cas:
Depuis le début de ma programmation, j'utilise les range("B"...);
La résultat est sur une ligne d'un fichier de format txt.

C'est difficile de comprendre ton problème sans code joint.

Mets au moins ton code en ligne pour voir comment tu crées ton fichier txt et génères tes lignes dans ce fichier.

Cordialement.

[gabi974]

Désolé, je ne peux pas le mettre de suite, je suis sur un autre projet qui n'a rien à voir avec la programmation.

Je te présenterai mon bout de code correspondant à mon problème.

à la prochaine,
gabi974.

EDIT:

Bonjour, voici une partie de mon code, j'ai modifier quelques noms; ect...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
 
 
 
Dim Imem As Long 'definition des bytes
Dim data(0 To 65536) As Byte
    For Imem = 0 To 65536
        Let data(Imem) = &HFF
    Next Imem
 
'créer un fichier h du nom de nom dossier
nf = FreeFile
    Let filename = Application.GetSaveAsFilename("nom dossier", "nom dossier (*.txt),*.txt", , "fichier")
    If filename = "Falsch" Then Exit Sub
 
 
' ouverture du fichier
Open filename For Output As #nf
 
 
 
For J = 5 To defderniereLigne + 1
 
    If Not IsEmpty(Range("B" & J).value) Then
        'effacer les espaces
        defaddname = LTrim(Range("B" & J).value)
        sansespdefaddname = Split(defaddname, " ")(0)
        'condition : si les cellules sont fusionné
        If Range("B" & J).MergeCells = True Then
            Set AireDesCellulesHexa = Range("B" & J).MergeArea
            L = 0
            For K = AireDesCellulesHexa.Count To 1 Step -1
        'ce que je veux changer, qui me cause problème 
        valeur = Application.WorksheetFunction.CountIf(Range("C" & J + n).variant, Range("C" & J).variant)
        '.Hex2Dec
 
            Print #nf, "#define "; sansespdefaddname; "_INIT "; valeur
        Else
            Print #nf, "#define "; sansespdefaddname; "_INIT "; Application.WorksheetFunction.Hex2Dec(Range("C" & J).value)
        End If
    End If
Next J
 
 
'fermeture du fichier obligatoire
Close (nf)
 
 
End Sub

il manque des Dim, mais c'est juste pour l'exemple.

Cordialement,
gabi974

EDIT:

J'ai oublié de préciser, je ne dois pas modifier ou apporter des valeurs sur le tableau, le résultat doit se faire directement sur le fichier TXT

[Invité]

Bonjour,

En admettant que les cellules de la colonne C contiennent les valeurs hexadécimales, le code pour générer le fichier txt pourrait être celui-là :

Nb :
- Le séparateur de champs est le ;
- les lignes écrivant sur le tableau sont neutralisées.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub RegrouperLesMesuresSurUneLigne()
 
Dim ShMesures As Worksheet
Dim AireMesures As Range
Dim CelluleMesure As Range
Dim AireDesCellulesHexa As Range
 
Dim DerniereLigne As Long
Dim I As Long
Dim J As Long
 
Dim FichierTexte As Object
Dim LigneFichierTexte As Object
Dim ContenuLigneFichierTexte As Variant
Dim NomDuFichierTxt As Variant
 
Dim SansEspDefAddName As Variant
 
    ChDir ActiveWorkbook.Path
 
    NomDuFichierTxt = Application.GetSaveAsFilename("nom dossier", "nom dossier (*.txt),*.txt", , "Fichier")
    If NomDuFichierTxt = False Then Exit Sub
 
    Set FichierTexte = CreateObject("Scripting.FileSystemObject")
    Set LigneFichierTexte = FichierTexte.CreateTextFile(NomDuFichierTxt, True)
 
    Set ShMesures = Sheets("Feuil1")
    With ShMesures
 
         '.Range(.Cells(1, 4), .Cells(.UsedRange.Rows.Count, .Columns.Count)).Clear
 
         DerniereLigne = .Cells(.Rows.Count, 2).End(xlUp).Row
         Set AireMesures = .Range(.Cells(1, 2), .Cells(DerniereLigne, 2))
 
         For Each CelluleMesure In AireMesures
             If CelluleMesure <> "" Then
 
                SansEspDefAddName = Split(LTrim(CelluleMesure), " ")(0)
 
                ContenuLigneFichierTexte = SansEspDefAddName & "_INIT;"
                If CelluleMesure.MergeCells = True Then
                   Set AireDesCellulesHexa = CelluleMesure.MergeArea
                   J = 0
                   For I = AireDesCellulesHexa.Count To 1 Step -1
                       ContenuLigneFichierTexte = ContenuLigneFichierTexte & AireDesCellulesHexa.Cells(I, 1).Offset(0, 1) & ";"
                      ' CelluleMesure.Offset(0, 2 + J) = AireDesCellulesHexa.Cells(I, 1).Offset(0, 1)
                      ' J = J + 1
                   Next I
                   ContenuLigneFichierTexte = Mid(ContenuLigneFichierTexte, 1, Len(ContenuLigneFichierTexte) - 1)
                   LigneFichierTexte.writeline (ContenuLigneFichierTexte)
                   Set AireDesCellulesHexa = Nothing
                Else
                   ContenuLigneFichierTexte = ContenuLigneFichierTexte & CelluleMesure.Offset(0, 1)
                   LigneFichierTexte.writeline (ContenuLigneFichierTexte)
                  ' CelluleMesure.Offset(0, 2) = CelluleMesure.Offset(0, 1)
                End If
             End If
        Next CelluleMesure
        Set AireMesures = Nothing
    End With
 
    LigneFichierTexte.Close
 
    Set LigneFichierTexte = Nothing
    Set FichierTexte = Nothing
    Set ShMesures = Nothing
 
End Sub

Cordialement.