Andy2483

¦^´_ 4# missbb


    ÁÂÁ«e½ú¦^´_,­×§ï¦p¤U,½Ð«e½ú°Ñ¦Ò
¦C¦L½d³ò(¤u§@ªí1©M2©Î¦³¤£¦P):¸g´ú¸Õ ­ì¤u§@ªí¦C¦L½d³ò·|±a¨ì·s½Æ»sªº³]©w

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim A, Z, i&, T$, T1$, T2$, F1 As Range, F2 As Range
Set Z = CreateObject("Scripting.Dictionary")
T1 = "¥t¦sÀɮ׸ô®|": T2 = "¥t¦sÀɮצWºÙ"
For i = 1 To Worksheets.Count
   Set F1 = Sheets(i).[1:1].Find(T1, Lookat:=xlWhole)
   Set F2 = Sheets(i).[2:2].Find(T2, Lookat:=xlWhole)
   If F1 Is Nothing Or F2 Is Nothing Then GoTo i01 Else T = F2(1, 2) & "/S"
   If Z(T) <> "" Then MsgBox F2(1, 2) & " ÀɦW­«½Æ,½ÐÀˬd": Exit Sub
   Z(T) = F1(1, 2) & "": Set Z(F2(1, 2) & "") = Sheets(i): Z(F2(1, 2) & "/a") = F1.Address
i01: Next
For Each A In Z.KEYS
   If Not IsObject(Z(A)) Then GoTo A01 Else T = Z(A & "/S")
   Z(A).Copy: If Dir(T, vbDirectory) = "" Then MkDir T
   With ActiveSheet.UsedRange: .Value = .Value: End With
   Range(Z(A & "/a")).Resize(2, 2) = ""
   With ActiveWorkbook: .SaveAs Filename:=T & "\" & A: .Close: End With
   ThisWorkbook.Activate
A01: Next
End Sub

missbb

¦^´_ 3# missbb


  ·Q¦A¦h°Ý, ¦pªG¦b¤u§@ªí³]©w¤F¦C¦L½d³ò(¤u§@ªí1©M2©Î¦³¤£¦P) , ¥t¦s·sÀɮɤ£·QÅã¥ÜÄæF ªº¸ô®|©MÀɮצW¦r, À³¦bVBA CODE¤º¨º¸Ì­×§ï?

«ô°U«ü¾É

missbb

¦^´_ 2# Andy2483

¦hÁ«ü¹D, :'(

Andy2483

¦^´_ 1# missbb


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨ÒÀÉ
«á¾ÇÂǦ¹©«½m²ß¦r¨å(ÀˬdÀɦW­«½Æ),¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò
Option Explicit
Sub TEST()
Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim A, Z, i&, T$, T1$, T2$, F1 As Range, F2 As Range
Set Z = CreateObject("Scripting.Dictionary")
T1 = "¥t¦sÀɮ׸ô®|": T2 = "¥t¦sÀɮצWºÙ"
For i = 1 To Worksheets.Count
   Set F1 = Sheets(i).[1:1].Find(T1, Lookat:=xlWhole)
   Set F2 = Sheets(i).[2:2].Find(T2, Lookat:=xlWhole)
   If F1 Is Nothing Or F2 Is Nothing Then GoTo i01 Else T = F2(1, 2) & "/S"
   If Z(T) <> "" Then MsgBox F2(1, 2) & " ÀɦW­«½Æ,½ÐÀˬd": Exit Sub
   Z(T) = F1(1, 2) & "": Set Z(F2(1, 2) & "") = Sheets(i)
i01: Next
For Each A In Z.KEYS
   If Not IsObject(Z(A)) Then GoTo A01 Else T = Z(A & "/S")
   Z(A).Copy: If Dir(T, vbDirectory) = "" Then MkDir T
   With ActiveSheet.UsedRange: .Value = .Value: End With
   With ActiveWorkbook: .SaveAs Filename:=T & "\" & A: .Close: End With
   ThisWorkbook.Activate
A01: Next
End Sub