web-dev-qa-db-fra.com

moyen rapide de copier le formatage dans Excel

J'ai deux morceaux de code. D'abord, un copier-coller standard de cellule A à cellule B

Sheets(sheet_).Cells(x, 1).Copy Destination:=Sheets("Output").Cells(startrow, 2)

Je peux faire presque la même chose en utilisant 

Sheets("Output").Cells(startrow, 2) = Sheets(sheet_).Cells(x, 1)

Maintenant, cette seconde méthode est beaucoup plus rapide, évitant de copier à nouveau dans le presse-papier et de coller à nouveau. Cependant, il ne copie pas le formatage comme le fait la première méthode. La deuxième version est presque instantanée pour copier 500 lignes, tandis que la première méthode ajoute environ 5 secondes à l’heure. Et la version finale pourrait être plus de 5000 cellules.

Donc, ma question peut être modifiée pour inclure la mise en forme de la cellule (principalement la couleur de la police) tout en restant rapide. 

Idéalement, j'aimerais pouvoir copier les valeurs de cellule dans un tableau/une liste avec la mise en forme de la police afin de pouvoir effectuer un tri et des opérations supplémentaires avant de les "coller" de nouveau dans la feuille de calcul. 

Donc, ma solution idéale serait quelque chose comme 

for x = 0 to 5000
array(x) = Sheets(sheet_).Cells(x, 1) 'including formatting
next

for x = 0 to 5000
Sheets("Output").Cells(x, 1)
next

est-il possible d'utiliser des chaînes RTF dans VBA ou est-ce uniquement possible dans vb.net, etc. 

Réponse*

Juste pour voir comment ma méthode origianl et ma nouvelle méthode comparent, voici les résultats ou avant et après 

Nouveau code = 65msec

Sheets("Output").Cells(startrow, 2) = Sheets(sheet_).Cells(x, 1)
Sheets("Output").Range("B" & startrow).Font.ColorIndex = Sheets(sheet_).Range("A" & x).Font.ColorIndex 'copy font colour as well

Ancien code = 1296msec

'Sheets("Output").Cells(startrow, 2).Value = Sheets(sheet_).Cells(x, 1)
'Sheets(sheet_).Cells(x, 1).Copy
'Sheets("Output").Cells(startrow, 2).PasteSpecial (xlPasteFormats)
'Application.CutCopyMode = False
vbacopyformatrtf
11
DevilWAH

Pour moi, tu ne peux pas. Mais si cela vous convient, vous pouvez utiliser les formats rapide et en copiant l’ensemble de la plage en une fois, au lieu de mettre en boucle:

range("B2:B5002").Copy Destination:=Sheets("Output").Cells(startrow, 2)

Et, en passant, vous pouvez créer une chaîne de plage personnalisée, telle que Range("B2:B4, B6, B11:B18") 

edit : si votre source est "clairsemée", ne pouvez-vous pas simplement formater la destination immédiatement lorsque la copie est terminée?

5
Patrick Honorez

Vous auriez pu simplement utiliser Range("x1").value(11) Quelque chose comme ci-dessous:

Sheets("Output").Range("$A$1:$A$500").value(11) =  Sheets(sheet_).Range("$A$1:$A$500").value(11)

range a la propriété par défaut "Value" et value peut avoir 3 orguments optionnels 10,11,12 . 11. Il n'utilise pas le presse-papiers, donc c'est plus rapide.- Durgesh

15
Durgesh

Rappelez-vous que lorsque vous écrivez:

MyArray = Range("A1:A5000")

vous écrivez vraiment

MyArray = Range("A1:A5000").Value

Vous pouvez également utiliser des noms:

MyArray = Names("MyWSTable").RefersToRange.Value

Mais la valeur n'est pas la seule propriété de Range. J'ai utilisé:

MyArray = Range("A1:A5000").NumberFormat

Je doute

MyArray = Range("A1:A5000").Font

fonctionnerait mais je m'attendrais

MyArray = Range("A1:A5000").Font.Bold

travailler.

Je ne sais pas quels formats vous voulez copier, vous devrez donc essayer.

Cependant, je dois ajouter que lorsque vous copiez et collez une grande plage, ce n'est pas aussi lent que de le faire via un tableau comme nous le pensions tous. 

Informations de post-édition

Après avoir posté ce qui précède, j'ai essayé par mes propres conseils. Mes expériences avec la copie de Font.Color et Font.Bold dans un tableau ont échoué.

Parmi les déclarations suivantes, la seconde échouerait avec une incompatibilité de type:

  ValueArray = .Range("A1:T5000").Value
  ColourArray = .Range("A1:T5000").Font.Color

ValueArray doit être de type variant. J'ai essayé les deux variantes et j'attends avec succès ColourArray sans succès.

J'ai rempli ColourArray avec des valeurs et essayé l'instruction suivante:

  .Range("A1:T5000").Font.Color = ColourArray

La totalité de la plage serait colorée selon le premier élément de ColourArray, puis Excel utilisait environ 45% du temps de traitement en boucle jusqu'à ce que je l'achève avec le Gestionnaire des tâches.

Le fait de basculer entre les feuilles de calcul est pénalisant dans le temps, mais des questions récentes sur la durée des macros ont amené tout le monde à revoir notre conviction selon laquelle le travail via des tableaux était beaucoup plus rapide.

J'ai construit une expérience qui reflète largement vos besoins. J'ai rempli la feuille de calcul Time1 avec 5000 lignes de 20 cellules formatées de manière sélective: gras, italique, souligné, en indice, avec bordure, rouge, vert, bleu, brun, jaune et gris - 80%.

Avec la version 1, je copiais toutes les 7 cellules de la feuille de calcul "Time1" dans la feuille de calcul "Time2".

Avec la version 2, je copiais toutes les 7 cellules de la feuille de calcul "Time1" dans la feuille de calcul "Time2" en copiant la valeur et la couleur via un tableau.

Avec la version 3, je copiais toutes les 7 cellules de la feuille de calcul "Time1" dans la feuille de calcul "Time2" en copiant la formule et la couleur via un tableau.

La version 1 prenait en moyenne 12,43 secondes, la version 2, 1,47 seconde, et la version 3, 1,83 seconde. La version 1 copiait les formules et toutes les mises en forme, la version 2 copiait les valeurs et les couleurs tandis que la version 3 copiait les formules et les couleurs. Avec les versions 1 et 2, vous pouvez ajouter du gras et de l'italique, par exemple, et avoir encore du temps en main. Cependant, je ne suis pas sûr que cela en vaille la peine étant donné que copier 21 300 valeurs ne prend que 12 secondes.

** Code pour la version 1 **

Je ne pense pas que ce code inclut tout ce qui nécessite une explication. Répondez avec un commentaire si je me trompe et je corrigerai.

Sub SelectionCopyAndPaste()

  Dim ColDestCrnt As Integer
  Dim ColSrcCrnt As Integer
  Dim NumSelect As Long
  Dim RowDestCrnt As Integer
  Dim RowSrcCrnt As Integer
  Dim StartTime As Single

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  NumSelect = 1
  ColDestCrnt = 1
  RowDestCrnt = 1
  With Sheets("Time2")
    .Range("A1:T715").EntireRow.Delete
  End With
  StartTime = Timer
  Do While True
    ColSrcCrnt = (NumSelect Mod 20) + 1
    RowSrcCrnt = (NumSelect - ColSrcCrnt) / 20 + 1
    If RowSrcCrnt > 5000 Then
      Exit Do
    End If
    Sheets("Time1").Cells(RowSrcCrnt, ColSrcCrnt).Copy _
                 Destination:=Sheets("Time2").Cells(RowDestCrnt, ColDestCrnt)
    If ColDestCrnt = 20 Then
      ColDestCrnt = 1
      RowDestCrnt = RowDestCrnt + 1
    Else
     ColDestCrnt = ColDestCrnt + 1
    End If
    NumSelect = NumSelect + 7
  Loop
  Debug.Print Timer - StartTime
  ' Average 12.43 secs
  Application.Calculation = xlCalculationAutomatic

End Sub

** Code pour les versions 2 et 3 **

La définition du type d'utilisateur doit être placée avant toute sous-routine dans le module. Le code utilise la feuille de calcul source en copiant des valeurs ou des formules et des couleurs dans l'élément suivant du tableau. Une fois la sélection effectuée, les informations collectées sont copiées dans la feuille de calcul de destination. Cela évite de basculer entre les feuilles de calcul plus qu’essentiel. 

Type ValueDtl
  Value As String
  Colour As Long
End Type

Sub SelectionViaArray()

  Dim ColDestCrnt As Integer
  Dim ColSrcCrnt As Integer
  Dim InxVLCrnt As Integer
  Dim InxVLCrntMax As Integer
  Dim NumSelect As Long
  Dim RowDestCrnt As Integer
  Dim RowSrcCrnt As Integer
  Dim StartTime As Single
  Dim ValueList() As ValueDtl

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  ' I have sized the array to more than I expect to require because ReDim
  ' Preserve is expensive.  However, I will resize if I fill the array.
  ' For my experiment I know exactly how many elements I need but that
  ' might not be true for you.
  ReDim ValueList(1 To 25000)

  NumSelect = 1
  ColDestCrnt = 1
  RowDestCrnt = 1
  InxVLCrntMax = 0      ' Last used element in ValueList.
  With Sheets("Time2")
    .Range("A1:T715").EntireRow.Delete
  End With
  StartTime = Timer
  With Sheets("Time1")
    Do While True
      ColSrcCrnt = (NumSelect Mod 20) + 1
      RowSrcCrnt = (NumSelect - ColSrcCrnt) / 20 + 1
      If RowSrcCrnt > 5000 Then
        Exit Do
      End If
      InxVLCrntMax = InxVLCrntMax + 1
      If InxVLCrntMax > UBound(ValueList) Then
        ' Resize array if it has been filled 
        ReDim Preserve ValueList(1 To UBound(ValueList) + 1000)
      End If
      With .Cells(RowSrcCrnt, ColSrcCrnt)
        ValueList(InxVLCrntMax).Value = .Value              ' Version 2
        ValueList(InxVLCrntMax).Value = .Formula            ' Version 3
        ValueList(InxVLCrntMax).Colour = .Font.Color
      End With
      NumSelect = NumSelect + 7
    Loop
  End With
  With Sheets("Time2")
    For InxVLCrnt = 1 To InxVLCrntMax
      With .Cells(RowDestCrnt, ColDestCrnt)
        .Value = ValueList(InxVLCrnt).Value                 ' Version 2
        .Formula = ValueList(InxVLCrnt).Value               ' Version 3
        .Font.Color = ValueList(InxVLCrnt).Colour
      End With
      If ColDestCrnt = 20 Then
        ColDestCrnt = 1
        RowDestCrnt = RowDestCrnt + 1
      Else
       ColDestCrnt = ColDestCrnt + 1
      End If
    Next
  End With
  Debug.Print Timer - StartTime
  ' Version 2 average 1.47 secs
  ' Version 3 average 1.83 secs
  Application.Calculation = xlCalculationAutomatic

End Sub
3
Tony Dallimore

Utilisez simplement la propriété NumberFormat après la propriété Value: .__ Dans cet exemple, les plages sont définies à l'aide de variables appelées ColLetter et SheetRow, qui proviennent d'une boucle for-next utilisant l'entier i, mais il peut s'agir de plages définies ordinaires.

TransferSheet.Range (ColLetter & SheetRow) .Value = Plage (ColLetter & i). Valeur TransferSheet.Range (ColLetter & SheetRow) .NumberFormat = Plage (ColLetter & i) .NumberFormat

0
Derek Sturdy