Voyons d'abord parcourir des fichiers en VB et utiliser des expressions régulières pour compléter la fonction de copie.
Copiez « Projet 1 », « Projet 1 » et les autres fichiers du fichier source sous le chemin « E:/my/Report/Achievements » vers le fichier cible. Voici comment procéder.
Private Sub Option1_Click()Dim myStr As String' En saisissant le numéro de série de l'article dans la cellule, il est spécifié par la méthode InputBox actuellement utilisée, et cette méthode peut également être utilisée. Choisissez l'un des deux. 'myStr = Sheets("Sheet1").Range("D21").Text '''''''''''''''''''''''''' '''' '''''''''''''''''''''' 'Entrez le numéro de série du projet via l'InputBox Start '''''''''''' ''''' '''''''''''''''''''''''''''''''''''' maStr = InputBox("Veuillez saisir le numéro de série du projet. Le numéro de série doit être en chiffres arabes. Le format doit être correct ! Le format est tel que " & Chr(34) & "2 éléments" & Chr(34)) '''' ''''''''''''''''''''''''''''''''''''''''''''' ' 'Entrez le numéro de série du projet via InputBoxEnd '''''''''''''''''''''''''''''''''''''' '''''''' ''''' Dim endNum As Integer 'La fonction MID intercepte le chiffre de fin endNum = InStrRev(myStr, "item") myStr = Mid(myStr, 1, endNum - 1) 'MsgBox myStr Dim CChinesStr As String CChineseStr = CChinese(myStr ) 'Convertir les chiffres arabes en caractères chinois'MsgBox CChineseStr '''''''''''''''''''''''''''' '''''''' '''''''''''''' 'Parcourir les fichiers sous le chemin Démarrer ''''''''''''''''' '''''''' '''''''''''''''''''''''''''' Dim fso En tant qu'objet Dossier Dim En tant qu'objet Sous-dossier Dim En tant qu'objet Fichier Dim En tant qu'objet Dim fileNameArray As String Dim basePath As String basePath = "E:/my/report/achievements" Set fso = CreateObject("scripting.filesystemobject") 'Créer un objet FSO Définir le dossier = fso.getfolder(basePath & "/source file") Pour chaque fichier dans le dossier.Files 'Parcourir les fichiers sous le dossier racine' fileNameArray = fileNameArray & file & "|" Dim mRegExp As Object 'Objet d'expression régulière Dim mMatches As Object 'Objet de collection de chaînes de correspondance Dim mMatch As Object 'Chaîne de correspondance Set mRegExp = CreateObject("Vbscript.Regexp") With mRegExp .Global = True 'True signifie correspondre à tous, False signifie correspondre uniquement La première correspondance item.IgnoreCase = True 'True signifie insensible à la casse, False signifie sensible à la casse'.Pattern = "([0-9])?[.]([0-9])+|([0-9])+" 'Correspondre au modèle de caractère'.Pattern = "((([0-9]+)? )|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9])?" 'Correspondre au modèle de caractère'.Pattern = "(Item(234)+)|(((234)?|(Deux cent trente-quatre) ?)Item(234)?)" 'Correspondre au modèle de caractère'.Pattern = "(((" & "+) ?)|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9 ])? " 'Correspondre au modèle de caractère.Pattern = "(item(" & CChineseStr & ")+)|(((" & myStr & ")?|(" & CChineseStr & ")?)item(" & myStr & ")?)" 'Correspondre au modèle de caractère'Set mMatches = .Execute(Sheets("Report").Range("D21").Text) 'Exécuter une recherche régulière et renvoyer un ensemble de tous les résultats correspondants S'il n'est pas trouvé, il sera vide Set mMatches =. .Execute(file) 'Exécuter une recherche régulière et renvoyer l'ensemble de tous les résultats correspondants. S'il n'est pas trouvé, il sera vide. Pour chaque mMatch In mMatches 'SumValueInText = SumValueInText + CDbl(mMatch.Value) 'SumValueInText = SumValueInText & mMatch. Valeur Si mMatch .Value <> "" Alors 'fileNameArray = fileNameArray & mMatch.Value & "_" fso.copyfile basePath & "/source file/" & mMatch.Value & ".*", basePath & "/target file" & myStr 'Copier l'opérationEnd If Next End With 'MsgBox fileNameArray Set mRegExp = Rien défini mMatches = Rien Next Set fso = Rien Définir le dossier = Rien ''''''''''''''''''''''''''''''' ''''''''' '''''''' 'Parcourir les fichiers sous le cheminFin '''''''''''''''''''''''''''''' '''''''''' '''''''' MsgBox "Opération terminée"End Sub'Convertir les chiffres arabes en caractères chinoisPrivate Function CChinese(StrEng As String) As String'Verify dataIf Not IsNumeric( StrEng) ThenIf Trim(StrEng) <> "" Then MsgBox « Numéro invalide »CChinese = « »Exit FunctionEnd If'define variable Dim intLen As Integer, intCounter As IntegerDim strCh As String, strTempCh As StringDim strSeqCh1 As String, strSeqCh2 As StringDim strEng2Ch As String'strEng2Ch = "zéro un deux trois quatre cinq et sept sept huit neuf" strEng2Ch = "zéro un deux trois quatre cinq six sept huit quatre-vingt-dix"'strSeqCh1 = " "strSeqCh1 = "Cent mille cent cent mille cent mille" strSeqCh2 = "Trillion"'Convertir en une chaîne représentant une valeur numérique StrEng = CStr(CDec( StrEng))'Enregistrer la longueur du nombreintLen = Len(StrEng )'Convertir en caractères chinoisPour intCounter = 1 To intLen'Renvoie le caractère chinois correspondant au nombre strTempCh = Mid(strEng2Ch, Mid(StrEng, intCounter, 1) + 1, 1)'Si un certain bit est nul If strTempCh = "zero" And intLen <> 1 Then'If ce dernier est également zéro, ou zéro apparaît dans les 1ère, 5ème, 9ème, 13ème, etc. positions à partir du bas, alors le caractère chinois "zéro" ne sera pas affiché Si Mid(StrEng, intCounter + 1, 1) = « 0 » Ou (intLen - intCounter + 1) Mod 4 = 1 Then strTempCh = « »ElsestrTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))End If'Pour la chaîne qui apparaît dans le dernier 1, nombres avec des chiffres de 5, 9, 13, etc. Si (intLen - intCounter + 1) Mod 4 = 1 Ensuite, ajoutez le bit "Trillion" strTempCh = strTempCh & Trim(Mid(strSeqCh2, (intLen - intCounter) / 4 + 1, 1))End If' pour former une expression chinoise strCh = strCh & Trim(strTempCh)NextCChinese = strChEnd Fonction
Supplément : Voyons comment utiliser VB pour renommer et copier des dossiers et des fichiers.
Private Sub commandButton1_Click()'Déclarez le nom et le chemin du dossier Dim FileName, Path As String, EmptySheet As String'Path = "D:/Report" Path = InputBox("Veuillez entrer" & Chr(34) & "Grade" & Chr ( 34) & « Le chemin d'accès au dossier, au format » & Chr(34) & « D:/grades » & Chr(34))FileName = Path & "/Last Semester"EmptySheet = Path & "/Semester Initialization"'MsgBox FileNameIf Dir(FileName, vbDirectory) <> ""Then'MsgBox "Le dossier existe"'Obtenir l'heure actuelle du système'Dim dd As Date'dd = Maintenant ' MsgBox Format(jj, « aaaamm »)Dim myTime As StringmyTime = InputBox(« Veuillez saisir l'heure actuelle au format de » & Chr(34) & "201811" & Chr(34))If myTime = "" ThenMsgBox "L'heure actuelle ne peut pas être vide ! Sinon, le dossier actuel ne peut pas être renommé" Else:Name FileName As Path & "" & myTimeEnd IfEnd If' Déterminez si le dossier existeSi Dir(FileName, vbDirectory) = "" Then'Create dossier MkDir (FileName)'MsgBox ("Créé")Else : MsgBox ("Le dossier est déjà là")Fin Si'Copiez la table vide dans le Set actuel Fso = CreateObject("Scripting.FileSystemObject")'Copiez le dossier Fso.copyfolder EmptySheet, FileName'Fso.copyfile EmptySheet&"c:*. *", "d:" 'Copier le fichier'FileSystemObject.copyfolder EmptySheet, FileName, 1MsgBox ("Opération réussie!")End Sub
Résumer
Ce qui précède est la méthode introduite par l'éditeur pour parcourir les fichiers en VB et utiliser des expressions régulières pour copier, renommer et copier des dossiers dans VB. J'espère que cela vous sera utile. Si vous avez des questions, veuillez me laisser un message. l'éditeur répondra à tout le monde à temps. Je voudrais également remercier tout le monde pour votre soutien au site Wulin.com !