Maison > Article > Tutoriel logiciel > Macro qui divise une feuille Excel en 300 lignes par feuille
Sub public monSub()
Dim shS As Worksheet : Set shS = ActiveSheet 'Fiche de données source, feuille active actuelle
Dim rS& : rS = 1 'Tableau de données source, commencez à lire les données de cette ligne
Dim rC& : rC = 300 'Le nombre de lignes lues à chaque fois
Dim rNew$ : rNew = 1 'Créez un nouveau tableau et collez les données dans cette ligne
Dim rZ& : rZ = shS.UsedRange.Row + shS.UsedRange.Rows.Count - 1
Dim shNew As Worksheet, nm$, n%, r&
r = rS
Faire pendant r
n = n + 1
Set shNew = Worksheets.Add(after:=Sheets(Worksheets.Count))
nm = "table" & rC & "__" & n
Appelez ShNm(shNew, nm)
shS.Rows(r).Resize(rC).Copier shNew.Rows(rNew)
r = rC * n + rS
Boucle
MsgBox "ok"
Fin du sous-marin
Public Sub ShNm (sh comme feuille de travail, nm comme variante)
En cas d'erreur, reprendre ensuite
100 :
sh.Name = nm
Si Err.Number 0 Alors
Euh.Clair
nm = Application.InputBox( _
"" " & nm & " " existe déjà ! " & Chr(10) & Chr(10) & " Veuillez saisir un nouveau nom de table : ", _
"Veuillez entrer le nouveau nom de la table", nm & "_new", _
Tapez :=2)
Si nm = False Then MsgBox "La saisie est incorrecte, quittez le programme !" : End
Aller à 100
Fin si
Fin du sous-marin
Sous Macro6()
'
'Macro6 Macro
'
'
Selection.TextToColumns Destination :=Range("A1"), DataType :=xlDelimited, _
TextQualifier :=xlDoubleQuote, ConsecutiveDelimiter :=False, Tab :=False, _
Point-virgule :=False, Virgule :=False, Espace :=False, Autre :=Vrai, OtherChar _
:="*", FieldInfo :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers :=True
Colonnes ("A:A").Sélectionnez
Selection.Replace What:="PL", Remplacement:="", LookAt:=xlPart, _
SearchOrder :=xlByRows, MatchCase :=False, SearchFormat :=False, _
ReplaceFormat :=False
Colonnes ("C:D").Sélectionnez
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Plage("C1").Sélectionner
ActiveCell.FormulaR1C1 = "=MIN(RC[-2],)"
Plage("C1").Sélectionner
ActiveCell.FormulaR1C1 = "=MIN(RC[-2],RC[-1])"
Plage("D1").Sélectionner
ActiveCell.FormulaR1C1 = "=MAX(RC[-3],RC[-2])"
Plage("C1:D1").Sélectionnez
Selection.AutoFill Destination:=Range("C1:D1000")
Plage("C:D").Sélectionnez
Colonnes ("A:B").Sélectionnez
Plage("B1").Activer
Colonnes ("C:D").Sélectionnez
Sélection.Copie
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=Faux, Transposer:=Faux
Colonnes ("A:B").Sélectionnez
Plage("B1").Activer
Application.CutCopyMode = False
Sélection.Supprimer Shift :=xlToLeft
Colonnes ("A:B").Sélectionnez
Selection.Replace What:="0", Remplacement:="", LookAt:=xlWhole, _
_
SearchOrder :=xlByRows, MatchCase :=False, SearchFormat :=False, _
ReplaceFormat :=False
Fin du sous-marin
Remarque : lorsque vous l'utilisez, sélectionnez d'abord la colonne A puis exécutez la macro. La colonne à diviser doit être dans la colonne A, et les deux colonnes BC sont vides, sinon elle sera écrasée (haha, le temps est court, pas particulièrement intelligent) et le nombre de lignes ne dépasse pas 1000 lignes. Haha, sinon ce sera un peu lent, donc la plage est fixée à 1000 lignes. Êtes-vous également engagé dans des structures en acier ? Haha aussi
Option explicite
Sous test()
Dim rng As Range
Dim arr comme variante
Dim k comme entier
Pour chaque rng en sélection
rng.Value = Remplacer(rng.Value, ":", "/")
arr = Split(rng.Valeur, "/")
k = UBound(arr) + 1
rng.Resize(1, k) = arr
Effacer arr
Rng suivant
End Sub Je pense que vous savez comment coller le code, je n'entrerai donc pas dans les détails. Appuyez simplement sur l'image ci-dessous pour exécuter le code que j'ai écrit pour vous :
étape 1
étape 2
étape 3
étape 4
Cliquez sur [Outils de développement]-[Visual Basic] ou sur la touche de raccourci Alt+F11 pour accéder à l'interface d'édition VBE.
Choisissez d'insérer un nouveau module
Collez le code suivant dans le module :
Sous CFGZB()
Dim myRange As Variant
Dim myArray
Dim titleRange As Range
Dim titre As String
Dim columnNum As Integer
myRange = Application.InputBox(prompt:="Veuillez sélectionner la ligne de titre :", Type:=8)
myArray = WorksheetFunction.Transpose(myRange)
Set titleRange = Application.InputBox(prompt:="Veuillez sélectionner l'en-tête divisé, qui doit être la première ligne et être une cellule, telle que : "Name"", Type:=8)
titre = titleRange.Value
Ce qui précède est le contenu détaillé de. pour plus d'informations, suivez d'autres articles connexes sur le site Web de PHP en chinois!