Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

laurent950 · 10 Juin 2012

Bonsoir le Forum,

Je cherche depuis pas mal de temps à intégrer des Format (Texte ou couleur cellule ou autres) dans une variable tableau sans passer par des procédures mais cela mais impossible est en fait après pas mal de recherche je ne sais pas trop mais il me semble que sur le site de BoisGontier il arrive à intégrer un format a une variable tableau mais je ne sais pas reproduire.
J’ai trouvé une astuce pour formater les cellules qui m’intéresse dans une boucle en même temps que je remplis ma variable tableau sauf :
- Que les cellules sont formater avant le résultat car le résultat est restitué à la fin en une fois j’aimerais faire en une seul fois cette action sans passer par une procédure.

J’envoie un code très simple de variable tableau et j’aimerais savoir si une personne a la solution pour remplacer la procédure pour la couleur pour faire tous en un seul passage de boucle est une seul restitution :
Code :

VB:

 ' Module (Macro)


Sub TabCouleur()

Dim T() As Variant
Dim F1 As Worksheet
Set F1 = ThisWorkbook.Worksheets("Feuil1")

' Efface les valleur de la feuilles
Range("B3:C18").ClearContents

' Efface les couleurs
    lign = 3
    col = 3
SansCouleur F1, lign, col

' Tableau
T = Range("A3:A18").Value
pos = Range("a3").Row

' Redimenion du tableau soit deux colonne supplémentaire
ReDim Preserve T(1 To 16, 1 To 3)

' Boucle
For i = 1 To UBound(T, 1)
    If T(i, 1) = "F" Then
        T(i, 2) = T(i, 1)
        T(i, 3) = "Sans couleur"
    ElseIf T(i, 1) = "y" Then
        T(i, 2) = T(i, 1)
        ' Procédure de mise en couleur
        lign = i + 2
        col = 2
        Resi = 2
        AvecCouleur F1, lign, col, Resi
        T(i, 3) = "Couleur"
    End If
Next i
        
' Colle version 1
'F1.[B3].Resize(UBound(T, 1), UBound(T, 2)) = T

' Mieux
For i = 2 To 3
     F1.Cells(3, i).Resize(UBound(T, 1)) = Application.Index(T, , i)
 Next i
 
' efface tous le Tableau T()
Erase T

Cells(1, 1).Select

End Sub

' ______________________________________________________________________________________________________

' Procédure Module (Couleur)


Sub AvecCouleur(ByVal F1, lign, col, Resi)
' Procedure (Renvois pas de resultat)

' faux Avec Souleur
    F1.Cells(lign, col).Resize(, Resi).Select
    With Selection
        .Font.Name = "Calibri"
        .Font.FontStyle = "Gras"
        .Font.Size = 11
        .Font.Underline = xlUnderlineStyleNone
        .Font.Color = 255
        .Font.ThemeFont = xlThemeFontMinor
        '.Borders(xlDiagonalDown).LineStyle = xlContinuous
        '.Borders(xlDiagonalUp).LineStyle = xlContinuous
        .Interior.Pattern = xlSolid
        .Interior.PatternColorIndex = xlAutomatic
        .Interior.Color = 65535
    End With
    
End Sub
Sub SansCouleur(ByVal F1, lign, col)
' Procedure (Renvois pas de resultat)

' Sans Couleur
    F1.Range(F1.Cells(lign, 2), F1.Cells(18, col)).Select
    With Selection
        .Font.Name = "Calibri"
        .Font.FontStyle = "Normal"
        .Font.Size = 11
        .Font.Underline = xlUnderlineStyleNone
        .Font.ColorIndex = xlAutomatic
        .Font.ThemeFont = xlThemeFontMinor
        '.Borders(xlDiagonalDown).LineStyle = xlNone
        '.Borders(xlDiagonalUp).LineStyle = xlNone
        .Interior.Pattern = xlNone
    End With
    
End Sub

PS : Pour ceux qui aurais vu se code il se trouve aussi sur cette page c’était pour finalisé :
-
- Avec les codes palettes couleurs Excel
- Color Palette and the 56 Excel ColorIndex Colors

En page 3 =>>> Poste 31

Je voulais ouvrir un nouveau poste pour une vrais solution qui est encore non trouver pour ma part a ce jour.
Au plaisir de partager avec vous ce poste est peux être que cette astuce en sera pour certain qui ne sont pas encore des pros comme ceux qui m’ont déjà répondu sur ce forum est que je salut.

Laurent

Bebere · 11 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

bonjour Laurent
à tester

Code:

Sub TabCouleur()
    Dim i As Long, Rng As Range
    Dim F1 As Worksheet

    Set F1 = ThisWorkbook.Worksheets("Feuil1")

    ' Efface tout
    F1.Range("B3:C18").Clear    'Contents
    Set Rng = F1.Range("A3:A18")

    ' Boucle
    For i = 1 To Rng.Rows.Count
        If Rng.Cells(i, 1) = "y" Then
            Rng.Cells(i, 2).Value = Rng.Cells(i, 1).Value
            With Rng.Cells(i, 2)
                .Font.Name = "Calibri"
                .Font.FontStyle = "Normal"
                .Font.Size = 11
                '        .Font.Underline = xlUnderlineStyleNone
                .Font.ColorIndex = 3    'rouge 'xlAutomatic
                '        .Font.ThemeFont = xlThemeFontMinor
                '.Borders(xlDiagonalDown).LineStyle = xlNone
                '.Borders(xlDiagonalUp).LineStyle = xlNone
                .Interior.Pattern = xlNone
            End With

        End If
    Next i
    F1.Cells(1, 1).Select
    Set Rng = Nothing
    Set F1 = Nothing

End Sub

pierrejean · 11 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonjour à tous

Voila comment j'aurais taité le problème (Mais Une Seule fois !!!!!)

laurent950 · 11 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonsoir Pierrejean,

J'ai presque la solution sur la methode en une seul fois et tous passer en paramétres tableau, je dois encore me creuser la tête mais je pense que d'ici peux je vais réellement trouver et je vais vous en faire par avec l'explication c'est ultra puissant.

Franchement merci pour votre exemple vous êtes vraiment très fort et c'est un peux grace a vos code VBA (dans les principe des tableau que j'ai pousser ma connaissance dans le developpment d'ailleur je finis une formation JAVA) des que j'ai l'astuce je vous en fait part

Ps : Merci Bebere pour ce bout de code

laurent

david84 · 11 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonsoir,
2 petits tests en passant mais je ne sais pas si c'est ce que tu veux (pour le test 1, rentrer des dates au format jj/mm/aaaa en A1:A10) :

Code:

Sub test()
Dim T, T2(), i&
T = [A1:A10]
ReDim T2(LBound(T) To UBound(T))
For i = LBound(T2) To UBound(T2)
    T2(i) = Format(T(i, 1), "dddd dd mm yyyy")
Next i
[B1].Resize(UBound(T2)).Interior.ColorIndex = 3
[B1].Resize(UBound(T2)) = Application.Transpose(T2)
End Sub

Sub test2()
Dim T, T2(), i&
T = Array(1, 2, 3)
ReDim T2(LBound(T) To UBound(T))
For i = LBound(T2) To UBound(T2)
    T2(i) = Format(T(i), "'0000")
Next i
[C1].Resize(UBound(T2) + 1) = Application.Transpose(T2)
End Sub

A+

laurent950 · 12 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonsoir David84,

Je vous remercie c'est l'idée en faite c'est cela, demain je vais tester au travail car il est déja tard et je me léve tôt demain mais je vous tiens au courrant et pierrejean sera aussi interresser je pense.

Je vous tiens au courrant demain merci David84 bonne fin de soirée

laurent

laurent950 · 14 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonsoir David84,

J'ai essayer quelque chose et je ne suis vraiment pas loin... Il me manque un petit quelque choses, j'ai chercher chercher mais impossible de rentrer cette couleur dans cette case du tableau sa bloque ?

Ps : j'ai trouver cette astuce sur ce site que j'ai essaye d'adapté... mais impossible.

Astuce VBA : mise en forme de caractres dans une cellule

Autre :

Code renvoi à la ligne sous VBA Excel [Résolu] | CommentCaMarche

C'est a Partir d'ici ?

'Partie 1 en ITALIQUE
T(i, 3).Characters(1, T(i, 4)).Font.Italic = True

' Impossible de rentrer le format dans la case de ce tableau ?

VB:

Sub TabCouleur()

Dim T() As Variant
Dim F1 As Worksheet
Set F1 = ThisWorkbook.Worksheets("Feuil1")

' Efface les valleur de la feuilles
Range("D1:D12").Clear

' Tableau
T = Range("A1:B12").Value

' Redimenion du tableau soit deux colonne supplémentaire
ReDim Preserve T(1 To 12, 1 To 5)

' Boucle
For i = 1 To UBound(T, 1)
    If T(i, 1) = "Oui" Then
    'Contenu divisé en un tableau de 3 parties
         tab_contenu = Split(T(i, 2), " ")
    'Longueur de la partie 1
         T(i, 4) = Len(tab_contenu(0))
    'Longueur de la partie 2
         T(i, 5) = Len(tab_contenu(1))
    ' Remplire la case du Tableau vide = 3
        T(i, 3) = T(i, 2)
    'Partie 1 en ITALIQUE
         T(i, 3).Characters(1, T(i, 4)).Font.Italic = True
    'Partie 1 en COULEUR ROUGE
         T(i, 3).Characters(1, T(i, 4)).Font.Color = 255
    'Partie 2 en GRAS
         T(i, 3).Characters(T(i, 4) + 2, T(i, 5)).Font.Bold = True
    ElseIf T(i, 1) = "Non" Then
    ' Remplire la case du Tableau vide = 3
         T(i, 3) = T(i, 2)
    'Partie 1 en COULEUR ROUGE
         T(i, 3).Characters(1, T(i, 4)).Font.Color = 6
    End If
Next i

' Mieux
For i = 3 To 3
     F1.Cells(1, 4).Resize(UBound(T, 1)) = Application.Index(T, , i)
 Next i
 
' efface tous le Tableau T()
Erase T

Cells(1, 1).Select

End Sub

Merci a vous tous qui aurait peut être la solution a cette méthode qui peux etre ultra puissante sur des nombres de donné très importantes traité en tableau

laurent

david84 · 15 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonjour,
à mon avis, ce que tu veux faire, à savoir utiliser des propriétés de mise en forme de texte à l'intérieur d'un Array n'est pas possible.
En fonction de la propriété concernée, tu peux en revanche obtenir ce que tu veux :
- au moment où tu reverseras dans la feuille de calcul les données de ton Array
- une fois les données inscrites sur la feuille de calcul.
A+

Bebere · 15 Juin 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

bonjour Laurent,Pierre Jean,David
comme suit

Code:

Sub TabCouleur()

Dim T As Range '() As Variant
Dim F1 As Worksheet
Set F1 = ThisWorkbook.Worksheets("Feuil1")

' Efface les valleur de la feuilles
Range("D1:E12").Clear

' Tableau
Set T = Range("A1:B12") '.Value

' Redimenion du tableau soit deux colonne supplémentaire
'ReDim Preserve T(1 To 12, 1 To 5)

' Boucle
For i = 1 To T.Rows.Count 'UBound(T, 1)
    If T.Cells(i, 1) = "Oui" Then
    'Contenu divisé en un tableau de 3 parties
         tab_contenu = Split(T(i, 2), " ")
    'Longueur de la partie 1
         T.Cells(i, 4) = Len(tab_contenu(0))
    'Longueur de la partie 2
         T.Cells(i, 5) = Len(tab_contenu(1))
    ' Remplire la case du Tableau vide = 3
        T.Cells(i, 3) = T.Cells(i, 2)
    'Partie 1 en ITALIQUE
         T.Cells(i, 3).Characters(1, T.Cells(i, 4)).Font.Italic = True
    'Partie 1 en COULEUR ROUGE
         T.Cells(i, 3).Characters(1, T.Cells(i, 4)).Font.Color = 255
    'Partie 2 en GRAS
         T.Cells(i, 3).Characters(T.Cells(i, 4) + 2, T.Cells(i, 5)).Font.Bold = True
    ElseIf T(i, 1) = "Non" Then
    ' Remplire la case du Tableau vide = 3
         T.Cells(i, 3) = T.Cells(i, 2)
    'Partie 1 en COULEUR ROUGE
         T.Cells(i, 3).Characters(1, T.Cells(i, 4)).Font.Color = 6
    End If
Next i

' Mieux
'For i = 3 To 3
'     F1.Cells(1, 4).Resize(UBound(T, 1)) = Application.Index(T, , i)
' Next i
 
' efface tous le Tableau T()
'Erase T

Cells(1, 1).Select

End Sub

laurent950 · 25 Juillet 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonsoir le forum,

Suite a une recherche sur ce forum je complete se poste a toute fin utile a toute a chacun, et pour moi aussi par la même ocasion.

Solution a = Variable tableau Array à deux dimensions, copier une dimension entière ?

VB:

Sub testTab()
 Dim Tblo(10, 4)
 
For i = 1 To 10
         For y = 1 To 4
             Tblo(i, y) = 12 * i + 4 * y
         Next y
 Next i
 'Le tableau entier :
 Range("A1").Resize(UBound(Tblo, 1), UBound(Tblo, 2)).Value = Tblo
 
'ligne à extraire en ligne :
 y = 3
 Range("A12").Resize(1, UBound(Tblo, 2)).Value = Application.Index(Tblo, y)
 
'colonne à extraire en ligne :
 y = 2
 Range("A14").Resize(1, UBound(Tblo, 1)).Value = Application.Index(Application.Transpose(Tblo), y)
 
'colonne à extraire en colonne :
 y = 2
 Range("A16").Resize(UBound(Tblo, 1), 1).Value = Application.Index(Tblo, , y)

' Autres exemples
' Extraire le tableau (une partie seulement)
' premiere ligne du tableau a une ligne donnée
' exemple tableau de 1 a 500 ligne et 1 a 20 Colonne
' extrire de la 1 er ligne a la 230 éme ligne et toutes
' les colonnes du tableau de la colonne 1 à 20
Range("A1").Resize(230, UBound(Tblo, 2)).Value = Tblo
 
End Sub

Laurent

VB:

Sub testTab()
 Dim Tblo(1 To 3000, 1 To 6)
 
For i = 1 To 3000
         For y = 1 To 6
             Tblo(i, y) = 12 * i + 4 * y
         Next y
 Next i
 
' Ont recupére Le tableau entier : toutes les lignes x toutes les colonnes
Range("K6").Resize(UBound(Tblo, 1), UBound(Tblo, 2)).Value = Tblo
 
' Extraire juste une ligne d'un tableau :
' soit la 3éme ligne du tableau sur les 6 colones
y = 3
 Range("B6").Resize(1, UBound(Tblo, 2)).Value = Application.Index(Tblo, y)
 
' Extraire une colone d'un tableau et la transposer en ligne :
' c'est a dire la colone N°2 du tableau a recopier en ligne
y = 2
 Range("A1").Resize(1, UBound(Tblo, 1)).Value = Application.Index(Application.Transpose(Tblo), y)
 
' Extraire une colone d'un tableau :
' c'est a dire la colone N°2 du tableau a recopier en colonne
y = 2
 Range("A8").Resize(UBound(Tblo, 1), 1).Value = Application.Index(Tblo, , y)
 
' Extraire la colone N°2 de la ligne 1 à 100
Range("C8").Resize(100, 1).Value = Application.Index(Tblo, , y)

' Extraire la colone N°2 de la ligne N°20 et recopier 2 fois
 Range("E8").Resize(2, 1).Value = Application.Index(Tblo, 20, y)

 ' est extraire la colone N°2 de la ligne 1001 à 2000
' impossible pour l'instant
 'Range("G8").Resize(2, 1).Value = Application.Index(Tblo, y)
 'Range("G8").Resize(1001, UBound(Tblo, 1)).Value = Application.Index(Tblo, y)

' Autres exemples
' Extraire le tableau (une partie seulement)
' premiere ligne du tableau a une ligne donnée
' exemple tableau de 1 a 500 ligne et 1 a 20 Colonne
' extrire de la 1 er ligne a la 230 éme ligne et toutes
' les colonnes du tableau de la colonne 1 à 20
Range("A1").Resize(230, UBound(Tblo, 2)).Value = Tblo

End Sub

' a finir !!

laurent950 · 25 Juillet 2012

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonsoir,

Suite de chez Boigontier toujours sur se forum, son exemple que je met à la suite.

Solution : Pour une recherche dans la première colonne d'un tableau 2D

VB:

sub test()
a = [A1:B4]
x = "cc"
p = Application.Match(x, Application.Index(a, , 1), 0)
MsgBox p
MsgBox a(p, 2)

' Données pour ce test :
''   A   B
'1  e   R
'2  e   R
'3  cc  V
'4  e   X
End sub

PS : Copier en une fois une zone de selection
T = Range(Cells(1, 1), Cells(Cells(65536, 1).End(xlUp).Row, Cells(1, 256).End(xlToLeft).Column))
soit :
Premiere ligne a la derniere
premiere colonne a la derniere

' Si il n'y a pas de valeur correspondante dans la colonne A c'est a dire "cc" il y a une erreur (faire une gestion des erreur !) mais
le code fonctionne (je l'ai mis ici pour des idées de developpement)

Merci Monsieur Boisgontier.

Laurent

laurent950 · 12 Août 2014

Re : Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

Bonsoir,

En complement une astuce pour colorié directement des cellule d'un tableau d'une feuilles Excel.

1 ) Crée une variable tableau de la zone de travaille
puis redimensioner se tableau pour créer des colonnes de travaille en mémoire

2 ) Crée le meme tableau sur la même zone mais cette fois avec une variable Objet c'est a dire Set =

voici le code et l'astuce d'un travail de repérage

VB:

Sub test2()

Dim TabOrg() As Variant
Dim Tabcoul As Range

TabOrg = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 2))
ReDim Preserve TabOrg(1 To UBound(TabOrg, 1), 1 To 5)

Set Tabcoul = Range(Cells(2, 1), Cells(Cells(65536, 1).End(xlUp).Row, 2))

For i = 1 To UBound(TabOrg, 1)
    For j = i + 1 To UBound(TabOrg, 1)
        If TabOrg(i, 1) = TabOrg(j, 1) Then
            TabOrg(j, 3) = "x"
        End If
    Next j
Next i

'CLng(xx) = Right(TabOrg(K, 2), Len(TabOrg(K, 2)) - 1)

For i = 1 To UBound(TabOrg, 1)
    If TabOrg(i, 3) = "" Then
        For j = i To UBound(TabOrg, 1)
            For k = i To UBound(TabOrg, 1)
                If TabOrg(i, 1) = TabOrg(j, 1) And TabOrg(i, 1) = TabOrg(k, 1) Then
                    If TabOrg(k, 2) Like "-" & "*" Then
                        If TabOrg(j, 2) = CLng(Right(TabOrg(k, 2), Len(TabOrg(k, 2)) - 1)) Then
                            ' reperage
                            TabOrg(j, 4) = "V"
                            TabOrg(k, 4) = "V"
                            ' couleur
                            Tabcoul(j, 2).Interior.ColorIndex = k
                            Tabcoul(k, 2).Interior.ColorIndex = k
                        End If
                    End If
                End If
            Next k
        Next j
    End If
Next i

'Cells(2, 1).Resize(UBound(TabOrg, 1), UBound(TabOrg, 2)) = TabOrg

End Sub

Ps : je joint le fichier excel avec le codes macro et exemple tableaux

Info : VBA [Toutes versions]- Détection de cellule vide Ligne/colonne

' Methode 1
DernLigne = Range("A65536").End(xlUp).Row
DernCol = Range("A1").End(xlToRight).Column

' Methode 2
DernLigne = Cells(65536, 1).End(xlUp).Row
DernCol = Cells(1, Cells.Columns.Count).End(xlToLeft).Column
laurent

laurent950 · 16 Janvier 2020

Bonsoir le forum,
Avec un module de classe a adapter (beaucoup de combinaison)

laurent

laurent950 · 22 Janvier 2020

Bonsoir
Interressant sur les arrays : (Remarque si très intressant sur VBA generale)
http://www.snb-vba.eu/VBA_Arrays_en.html
http://www.snb-vba.eu/inhoud_en.html

ParamArray :

laurent950

patricktoulon · 23 Janvier 2020

bonjour laurent

il ne faut pas confondre une variable tableau et une variable range

tablo=range("A1:B10").value ' tablo est une variable tableau

set tablo2=range("A1:B10")'tablo2 est une variable range

les deux n'ont rien a voir l'une envers l'autre 😉
il est absolument impossible de formater une variable tableau

au fur et a mesure du fil je pige plus très bien ce que tu veux faire exactement

a ce que je vois dans ton dernier exemple tu applique a une range un tableau de format

tablo de format est pas la bonne expressionen fait
ca serait plutôt tableau de données de format

que tu applique dans une boucle
autrement dis toujours pas en une seul fois

"en une seule fois" est chose impossible si la données de format n'est pas identique pour chaque cellules

Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

laurent950

XLDnaute Barbatruc

Pièces jointes

Bebere

XLDnaute Barbatruc

pierrejean

XLDnaute Barbatruc

Pièces jointes

laurent950

XLDnaute Barbatruc

david84

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Pièces jointes

david84

XLDnaute Barbatruc

Bebere

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

Pièces jointes

laurent950

XLDnaute Barbatruc

Pièces jointes

laurent950

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Discussions similaires

Variable Tableau & Format (Et Restitution Du Résultat En Une Seul Fois)

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency