VBA Macro pour déplacer des cellules sur une nouvelle feuille Excel basée sur la teneur en cellule
Question
Je regarde autour de moi et je n'ai pas pu trouver la réponse spécifique dont j'ai besoin. Donc je vais demander. J'ai une feuille (feuille1) avec des données uniquement sur la colonne A. Cela ressemble à ceci:
Et j'ai besoin de créer une macro VBA qui recherche dans la colonne A pour toute cellule contenant une pièce d'identité, Titl et Auth. Et déplacez-les dans une colonne spécifique dans une autre feuille (feuille2). La feuille2 aura 3 colonnes: id, titre et auteur.
La chose est que, avec la copie des données de la cellule sur sa colonne spécifique de la feuille2, il doit également supprimer la première partie des données. Par example: ID: R564838 dans la feuille1 doit être déplacé dans la colonne ID dans la feuille2, sans "ID:" dedans. Donc, seul le R564838 devrait être déplacé. Aussi "Titl:" et "Auth:" aurait besoin d'être supprimés lors de la copie.
J'espère que cela a du sens. Je vais juste apprendre les macros VBA. Donc, je n'ai aucune idée de comment accomplir cela.
J'ai ce code:
Sub MoveOver()
Cells(1, 1).Activate
While Not ActiveCell = ""
If UCase(Left(ActiveCell, 4)) = " ID" Then Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move ID to Col A in sheet 2
If UCase(Left(ActiveCell, 4)) = "TITL" Then Sheets(2).Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move TITL to Col B in sheet 2
If UCase(Left(ActiveCell, 4)) = "AUTH" Then Sheets(2).Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Value = _
Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell))) 'Move AUTH to Col C in sheet 2
ActiveCell.Offset(1, 0).Activate
Wend
end sous
et ça marche. Mais il y a une authentification et titl dans la feuille1 qui sont vides. Et la situation est que lorsque cela fonctionne, il ne laisse pas une cellule vide chaque fois qu'Iut ou titl est vide. J'ai besoin de la macro pour laisser une cellule vide si auth ou titl sont en blanc afin que les informations correspondent à chaque livre. J'espère que vous comprenez mon problème.
Merci encore!
La solution
Définissez certaines variables pour vous assurer que vous travaillez sur le bon classeur / feuille / colonne
Set wb = ThisWorkbook
Set ws1 = wb.Sheets(1)
Set ws2 = wb.Sheets(2)
col = 1
Trouver la dernière cellule de la colonne
last1 = ws1.Cells(ws1.Rows.Count, col).End(xlUp).Row
Regardez chaque cellule pour déterminer quoi faire avec elle
For x = 1 To last1
'What you do with each cell goes here
Next x
Évaluez le contenu de la cellule (savoir s'il contient quelque chose de spécifique)
If ws1.Cells(x, col) Like "*ID:*" Then
'What you do with a cell that has "ID:" in it
End If
extraire le contenu de l'intérêt de la cellule (supprimer "l'en-tête")
myID = Mid(ws1.Cells(x, col), InStr(ws1.Cells(x, col), "ID:") + Len("ID:"))
Placez le contenu dans la prochaine ligne disponible de la deuxième feuille (supposant que l'ID passe dans la colonne 1)
current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws2.Cells(current2, 1) = myID
Déterminez comment mettre les bits du code ensemble et l'adapter à vos besoins exacts!
Fondamentalement, oui, mais vous pouvez heurter des problèmes car il n'est pas pleinement complet de votre situation particulière. Ce que vous pourriez avoir à faire est:
- Stockez l'identifiant (une fois que vous en trouvez une) dans une variable;
- Faites de même pour le titre et l'auteur;
- Une fois que vous avez trouvé une ligne de délimitation, vous écrivez plutôt le contenu actuel des variables à la ligne disponible suivante et videz le contenu de ces variables.
Par exemple:
If ws1.cells(x, col) Like "*----*" Then
current2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row + 1
ws2.Cells(current2, 1) = myID
ws2.Cells(current2, 2) = myTitle
ws2.Cells(current2, 3) = myAuthor
myID = ""
myTitle = ""
myAuthor = ""
End If
Vous allez ici :)
Sub MoveOver()
Cells(1, 1).Activate
myId = ""
myTitle = ""
myAuthor = ""
While Not ActiveCell = ""
If UCase(Left(ActiveCell, 4)) Like "*ID*" Then myId = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))
If UCase(Left(ActiveCell, 4)) = "TITL" Then myTitle = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))
If UCase(Left(ActiveCell, 4)) = "AUTH" Then myAuthor = Trim(Mid(ActiveCell, InStr(1, ActiveCell, ":") + 1, Len(ActiveCell)))
If ActiveCell Like "*---*" Then
'NOW, MOVE TO SHEET2!
toRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
Sheets(2).Cells(toRow, 1) = myId
Sheets(2).Cells(toRow, 2) = myTitle
Sheets(2).Cells(toRow, 3) = myAuthor
myId = ""
myTitle = ""
myAuthor = ""
End If
ActiveCell.Offset(1, 0).Activate
Wend
Si vous avez besoin d'aide pour comprendre ce que j'ai changé, faites-le-moi savoir, mais cela devrait être assez simple!
Autres conseils
Vous pouvez également essayer d'essayer de faire un texte à la colonne avec un: comme séparateur.Cela donnerait à vos informations dans 2 colonnes au lieu de 1, vous pouvez ensuite rechercher une colonne pour l'en-tête et copier la valeur de la colonne suivante, vide ou autrement.