Давайте сначала рассмотрим перемещение файлов в VB и использование регулярных выражений для выполнения функции копирования.
Скопируйте «Проект 1», «Проект 1» и другие файлы из исходного файла по пути «E:/my/Report/Achievements» в целевой файл. Вот как это сделать.
Private Sub Option1_Click()Dim myStr As String' При вводе серийного номера элемента в ячейку он определяется используемым в данный момент методом InputBox, и этот метод также можно использовать. Выберите один из двух. 'myStr = Sheets("Лист1").Range("D21").Text '''''''''''''''''''''''''''' '''' ''''''''''''''''''''''' 'Введите серийный номер проекта через поле ввода. Старт '''''''''''' ''''' ''''''''''''''''''''''''''''''''''''' '' myStr = InputBox("Пожалуйста, введите серийный номер проекта. Серийный номер должен быть арабскими цифрами. Формат должен быть правильным! Формат такой: " & Chr(34) & "2 items" & Chr(34)) '''' '''''''' ''''''''''''''''''''''''''''''''''''''' ' 'Введите серийный номер проекта через InputBoxEnd ''''''''''''''''''''''''''''''''''''''' '''''''' ''''' Dim endNum As Integer 'Функция MID перехватывает конечную цифру endNum = InStrRev(myStr, "item") myStr = Mid(myStr, 1, endNum - 1) 'MsgBox myStr Dim CChinesStr As String CCchineseStr = CCchinese(myStr) ) 'Преобразовать арабские цифры в китайские символы'MsgBox CCchineseStr ''''''''''''''''''''''''''''''' '''''''' '''''''''''''' 'Обход файлов по пути Start ''''''''''''''''''' '''''''' ''''''''''''''''''''''''''''' Dim fso Как объект Dim папка как объект Dim подпапка как объект Dim файл как объект Dim fileNameArray As String Dim basePath As String basePath = "E:/my/report/achievements" Set fso = CreateObject("scripting.filesystemobject") 'Создать объект FSO Установить папку = fso.getfolder(basePath & "/source file") Для каждого файла в папке.Files «Обход файлов в корневой папке» fileNameArray = fileNameArray & file & «|» Dim mRegExp As Object 'Объект регулярного выражения Dim mMatches As Object 'Сопоставить объект коллекции строк Dim mMatch As Object 'Сопоставить строку Set mRegExp = CreateObject("Vbscript.Regexp") With mRegExp .Global = True 'True означает соответствие всем, False означает соответствие только первое совпадение item.IgnoreCase = True 'True означает, что регистр не учитывается, False означает, что регистр чувствителен'.Pattern = "([0-9])?[.]([0-9])+|([0-9])+" 'Соответствие шаблону символов'.Pattern = "((([0-9]+)? )|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9])?" «Соответствие шаблону символов». Шаблон = "(Item(234)+)|(((234)?|(Двести тридцать четыре)?)Item(234)?)" 'Соответствие шаблону символов'.Pattern = "(((" & "+) ?)|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9 ])? " 'Соответствовать шаблону символов.Pattern = "(item(" & CCchineseStr & ")+)|(((" & myStr & ")?|(" & CCchineseStr & ")?)item(" & myStr & ")?)" 'Соответствие шаблону символов'Set mMatches = .Execute(Sheets("Report").Range("D21").Text) 'Выполнить обычный поиск и вернуть набор всех совпадающих результатов, если он не найден, он будет пустым Set mMatches =. .Execute(file) 'Выполнить обычный поиск и вернуть набор всех совпадающих результатов. Если он не найден, он будет пустым. Для каждого mMatches 'SumValueInText = SumValueInText + CDbl(mMatch.Value) 'SumValueInText = SumValueInText & mMatch. Значение Если mMatch .Value <> "" Тогда 'fileNameArray = fileNameArray & mMatch.Value & "_" fso.copyfile basePath & "/source file/" & mMatch.Value & ".*", basePath & "/target file" & myStr 'Операция копированияEnd If Next End With 'MsgBox fileNameArray Set mRegExp = Ничего не установлено mMatches = Ничего следующего не установлено fso = Ничего Установить папку = Ничего '''''''''''''''''''''''''''''''''' ''''''''' ''''''''' 'Обход файлов по путиEnd ''''''''''''''''''''''''''''''''' '''''''''' ''''''''' MsgBox «Операция завершена»End Sub'Преобразовать арабские цифры в китайские иероглифыЧастная функция CCchinese(StrEng As String) As String'Проверить данныеЕсли не является числом(StrEng) ТогдаЕсли Trim(StrEng) <> «» Тогда MsgBox «Неверный номер»CCchinese = «»Выход FunctionEnd If'define переменная Dim intLen As Integer, intCounter As IntegerDim strCh As String, strTempCh As StringDim strSeqCh1 As String, strSeqCh2 As StringDim strEng2Ch As String'strEng2Ch = "ноль один два три четыре пять и семь семь восемь девять" strEng2Ch = "ноль один два три четыре пять шесть семь восемь девяносто"'strSeqCh1 = " "strSeqCh1 = "Сто тысяч одна сто сто тысяча сто тысяч" strSeqCh2 = "Trillion"'Преобразовать в строку, представляющую числовое значение StrEng = CStr(CDec(StrEng))'Запишите длину числа intLen = Len(StrEng) )'Преобразовать в китайские иероглифыFor intCounter = 1 To intLen'Возвращает китайский иероглиф, соответствующий числу strTempCh = Mid(strEng2Ch, Mid(StrEng, intCounter, 1) + 1, 1)'Если определенный бит равен нулю, If strTempCh = "ноль" And intLen <> 1 then'If последний тоже равен нулю, либо на 1-й, 5-й, 9-й, 13-й и т. д. позициях снизу появляется ноль, то китайский иероглиф «ноль» отображаться не будет. Если Mid(StrEng, intCounter + 1, 1) = «0» Или (intLen - intCounter + 1) Mod 4 = 1 Тогда strTempCh = «»ElsestrTempCh = strTempCh & Trim(Mid(strSeqCh1, intLen - intCounter + 1, 1))End If'Для строки, которая появляется в последняя 1, числа с цифрами 5, 9, 13 и т. д. Если (intLen - intCounter + 1) Mod 4 = 1 Затем добавьте бит «Триллион» strTempCh = strTempCh & Trim(Mid(strSeqCh2, (intLen - intCounter) / 4 + 1, 1))End If', чтобы сформировать китайское выражение strCh = strCh & Trim(strTempCh)NextCCchinese = strChEnd ФункцияДополнение: Давайте посмотрим, как использовать VB для переименования и копирования папок и файлов.
Частная подкомандаButton1_Click()'Объявите имя папки и путь. Dim FileName, Path As String, EmptySheet As String'Path = "D:/Report" Path = InputBox("Пожалуйста, введите" & Chr(34) & "Grade" & Chr ( 34) & «Путь к папке в формате» & Chr(34) & «D:/grades» & Chr(34))FileName = Path & "/Last Semester"EmptySheet = Path & "/Semester Initialization"'MsgBox FileNameIf Dir(FileName, vbDirectory) <> ""Then'MsgBox "Папка существует"'Получить текущее системное время'Dim dd As Date'dd = Now ' MsgBox Format(dd, «ггггмм»)Dim myTime As StringmyTime = InputBox («Пожалуйста, введите текущее время в формате» & Chr(34) & "201811" & Chr(34))If myTime = "" thenMsgBox "Текущее время не может быть пустым! В противном случае текущая папка не может быть переименована" Else:Name FileName As Path & "" & myTimeEnd IfEnd If' Определить, будет ли папка существуетЕсли Dir(FileName, vbDirectory) = "" Тогда'Создать папку MkDir (FileName)'MsgBox ("Создано")Другое: MsgBox («Папка уже существует») End If'Скопируйте пустую таблицу в текущую Set Fso = CreateObject(»Scripting.FileSystemObject»)'Скопируйте папку Fso.copyfolder EmptySheet, FileName'Fso.copyfile EmptySheet&»c:*. *", "d:" 'Копировать файл'FileSystemObject.copyfolder EmptySheet, FileName, 1MsgBox ("Операция прошла успешно!")End SubПодвести итог
Вышеупомянутый редактор представляет собой метод перемещения по файлам в VB и использования регулярных выражений для копирования, переименования и копирования папок в VB. Надеюсь, это будет вам полезно. Если у вас есть какие-либо вопросы, оставьте мне сообщение. Редактор ответит всем вовремя. Я также хотел бы поблагодарить всех за поддержку сайта Wulin.com!