ก่อนอื่น มาดูที่การข้ามไฟล์ใน VB และใช้นิพจน์ทั่วไปเพื่อทำให้ฟังก์ชันการคัดลอกสมบูรณ์
คัดลอก "Project 1", "Project 1" และไฟล์อื่นๆ ในไฟล์ต้นฉบับภายใต้พาธ "E:/my/Report/Achievements" ไปยังไฟล์เป้าหมาย ต่อไปนี้เป็นวิธีดำเนินการ
Private Sub Option1_Click()Dim myStr As String' โดยการป้อนหมายเลขซีเรียลของรายการในเซลล์ จะมีการระบุโดยวิธี InputBox ที่ใช้อยู่ในปัจจุบัน และยังสามารถใช้วิธีนี้ได้เช่นกัน เลือกหนึ่งในสอง 'myStr = Sheets("Sheet1").Range("D21").Text '''''''''''''''''''''''''''' '''''' '''''''''''''''''''''''''' 'ป้อนหมายเลขซีเรียลของโครงการผ่านกล่องป้อนข้อมูลเริ่มต้น '''''''''''' ''''' '''''''''''''''''''''''''''''''''''''' '' myStr = InputBox("กรุณากรอกหมายเลขซีเรียลของโครงการ หมายเลขซีเรียลจะต้องเป็นตัวเลขอารบิก รูปแบบจะต้องถูกต้อง! รูปแบบคือ " & Chr(34) & "2 รายการ" & Chr(34)) '''' '''''''' '''''''''''''''''''''''''''''''''''''''''''' ' 'กรอกหมายเลขซีเรียลของโครงการผ่านทาง InputBoxEnd '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '''''' Dim endNum As Integer 'ฟังก์ชัน MID ตัดตัวเลขสุดท้าย endNum = InStrRev(myStr, "item") myStr = Mid(myStr, 1, endNum - 1) 'MsgBox myStr Dim CChinesStr As String CChineseStr = CChinese(myStr ) 'แปลงเลขอารบิคเป็นตัวอักษรจีน'MsgBox C ChineseStr '''''''''''''''''''''''''''''' '''''''''' '''''''''''''''''' 'สำรวจไฟล์ภายใต้เส้นทางเริ่มต้น '''''''''''''''''''' '''''''' '''''''''''''''''''''''''''''''' Dim fso As Object Dim โฟลเดอร์ As Object Dim โฟลเดอร์ย่อย As Object Dim ไฟล์ As Object Dim fileNameArray As String Dim basePath As String basePath = "E:/my/report/achievements" Set fso = CreateObject("scripting.filesystemobject") 'สร้างวัตถุ FSO ตั้งโฟลเดอร์ = fso.getfolder(basePath & "/source file") สำหรับแต่ละไฟล์ในโฟลเดอร์ ไฟล์ 'สำรวจไฟล์ภายใต้โฟลเดอร์รูท' fileNameArray = fileNameArray & file & "|" Dim mRegExp As Object 'วัตถุนิพจน์ทั่วไป Dim mMatches As Object 'จับคู่วัตถุคอลเลกชันสตริง Dim mMatch As Object 'จับคู่สตริง ตั้ง mRegExp = CreateObject("Vbscript.Regexp") ด้วย mRegExp .Global = True 'True หมายถึงการจับคู่ทั้งหมด, False หมายถึงการจับคู่เท่านั้น การจับคู่ครั้งแรก item.IgnoreCase = True 'True หมายถึงไม่คำนึงถึงตัวพิมพ์เล็กและตัวพิมพ์ใหญ่ False หมายถึงคำนึงถึงตัวพิมพ์เล็กและตัวพิมพ์ใหญ่' รูปแบบ = "[0-9])?[.]([0-9])+|([0-9])+" 'Match character pattern'.Pattern = "((([0-9]+)? )|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9])?" 'จับคู่รูปแบบอักขระ'.Pattern = "(Item(234)+)|(((234)?|(สองร้อยสามสิบสี่)?)Item(234)?)" 'Match character pattern'.Pattern = "(((" & "+) ?)|(([一二三四五六七八九十]+)?)) item(([一二三四五六七八九十]+)?)|([0-9 ])? " 'จับคู่รูปแบบตัวอักษร รูปแบบ = "(item(" & C ChineseStr & ")+)|(((" & myStr & ")?|(" & C ChineseStr & ")?)item(" & myStr & ")?)" 'จับคู่รูปแบบอักขระ'ตั้งค่า mMatches = .Execute(Sheets("Report").Range("D21").Text) 'ดำเนินการค้นหาปกติและส่งกลับชุดผลลัพธ์ที่ตรงกันทั้งหมด หากไม่พบ จะว่างเปล่า Set mMatches = .Execute(file) 'ดำเนินการค้นหาตามปกติและส่งคืนชุดผลลัพธ์ที่ตรงกันทั้งหมด หากไม่พบ มันจะว่างเปล่า 'SumValueInText = SumValueInText & mMatch' ค่า ถ้า mMatch .Value <> "" จากนั้น 'fileNameArray = fileNameArray & mMatch.Value & "_" fso.copyfile basePath & "/source file/" & mMatch.Value & ".*", basePath & "/target file" & myStr 'คัดลอกการดำเนินการสิ้นสุดถ้าถัดไปสิ้นสุดด้วย 'MsgBox fileNameArray ตั้งค่า mRegExp = ไม่มีการตั้งค่า mMatches = ไม่มีการตั้งค่าถัดไป fso = ไม่มีอะไรตั้งค่าโฟลเดอร์ = ไม่มีอะไรเลย '''''''''''''''''''''''''''''''''' '''''''''' '''''''''' 'สำรวจไฟล์ภายใต้ pathEnd '''''''''''''''''''''''''''''''' '''''''''''' '''''''''' MsgBox "การดำเนินการเสร็จสมบูรณ์"สิ้นสุด Sub'แปลงเลขอารบิคเป็นตัวอักษรจีนฟังก์ชันส่วนตัว Cจีน(StrEng As String) As String'ตรวจสอบข้อมูลถ้าไม่ใช่ตัวเลข (StrEng) แล้วถ้าตัด(StrEng) <> “” แล้ว MsgBox “หมายเลขไม่ถูกต้อง”Cจีน = “”ออกจาก 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 = "One Hundred Thousand One Hundred One Hundred Thousand One Hundred Thousand" strSeqCh2 = "Trillion"'แปลงเป็นสตริงที่แสดงค่าตัวเลข StrEng = CStr(CDec( StrEng))'บันทึกความยาวของตัวเลขintLen = Len(StrEng )'แปลงเป็นตัวอักษรจีนสำหรับ intCounter = 1 ถึง intLen'ส่งคืนอักขระจีนที่สอดคล้องกับตัวเลข strTempCh = Mid(strEng2Ch, Mid(StrEng, intCounter, 1) + 1, 1)'ถ้าบิตใดค่าหนึ่งเป็นศูนย์ ถ้า strTempCh = "ศูนย์" และ intLen <> 1 แล้ว'ถ้า อันหลังก็เป็นศูนย์เช่นกัน หรือศูนย์ปรากฏในตำแหน่งที่ 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 จากนั้น 'เพิ่มบิต "Trillion" strTempCh = strTempCh & Trim(Mid(strSeqCh2, (intLen - intCounter) / 4 + 1, 1))End If' เพื่อสร้างสำนวนภาษาจีน strCh = strCh & Trim(strTempCh)NextCChinese = strChEnd การทำงานภาคผนวก: มาดูวิธีใช้ VB เพื่อเปลี่ยนชื่อและคัดลอกโฟลเดอร์และไฟล์กัน
Private Sub commandButton1_Click()'ประกาศชื่อโฟลเดอร์และพาธ Dim FileName, Path As String, EmptySheet As String'Path = "D:/Report" Path = InputBox("Please enter" & Chr(34) & "Grade" & Chr ( 34) & “เส้นทางไปยังโฟลเดอร์ ในรูปแบบของ” & Chr(34) & “D:/grades” & Chr(34))FileName = Path & "/ภาคการศึกษาสุดท้าย"EmptySheet = เส้นทาง & "/การเริ่มต้นภาคการศึกษา"'MsgBox FileNameIf Dir (ชื่อไฟล์, vbDirectory) <> ""แล้ว'MsgBox "มีโฟลเดอร์อยู่"'รับเวลาระบบปัจจุบัน'Dim dd As Date'dd = ตอนนี้ ' MsgBox Format(dd, “yyyymm”) Dim myTime As StringmyTime = InputBox(“Please enter the current time in the format of” & Chr(34) & "201811" & Chr(34))If myTime = "" ThatMsgBox "เวลาปัจจุบันไม่สามารถว่างเปล่าได้ มิฉะนั้น โฟลเดอร์ปัจจุบันไม่สามารถเปลี่ยนชื่อ"Else:Name FileName As Path & "" & myTimeEnd IfEnd If' ตรวจสอบว่าโฟลเดอร์ มีอยู่ถ้า Dir(FileName, vbDirectory) = "" จากนั้น 'สร้างโฟลเดอร์ MkDir (ชื่อไฟล์)'MsgBox ("สร้าง") อื่น ๆ: MsgBox ("โฟลเดอร์มีอยู่แล้ว")สิ้นสุด If'คัดลอกตารางว่างไปยังชุดปัจจุบัน Fso = CreateObject("Scripting.FileSystemObject")'คัดลอกโฟลเดอร์ Fso.copyfolder EmptySheet, FileName'Fso.copyfile EmptySheet&"c:*. *", "d:" 'คัดลอกไฟล์'FileSystemObject.copyfolder EmptySheet, FileName, 1MsgBox ("การดำเนินการสำเร็จ!") End Subสรุป
ข้างต้นเป็นวิธีการที่แนะนำโดยโปรแกรมแก้ไขเพื่อสำรวจไฟล์ใน VB และใช้นิพจน์ทั่วไปเพื่อคัดลอกและเปลี่ยนชื่อและคัดลอกโฟลเดอร์ใน VB ฉันหวังว่ามันจะเป็นประโยชน์กับคุณ หากคุณมีคำถามใด ๆ โปรดฝากข้อความถึงฉัน บรรณาธิการจะตอบกลับทุกคนทันเวลา ฉันอยากจะขอบคุณทุกคนที่ให้การสนับสนุนเว็บไซต์ Wulin.com!