ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¥HCÄ欰¯Á¤Þ,§R°£¤£¥²­nªº¦C¼Æ,¦A¥t¦s·sÀÉ

[µo°Ý] ¥HCÄ欰¯Á¤Þ,§R°£¤£¥²­nªº¦C¼Æ,¦A¥t¦s·sÀÉ

¦U¦ì¤j¤j¦n,

¸ËÂd³qª¾ªº ²Ä6¦C¬°ªíÀY,¸ê®Æ½d³ò¬° ²Ä7¦C~DÄ檺TOTAL¤§¶¡,¸ê®Æ·|ÀHµÛ»Ý¨D,¦Ó¼W¥[or´î¤Ö

§Ú­n¥HCÄ欰¯Á¤Þ,§R°£¤£¥²­nªº¦C¼Æ,¨Ã±N¸ê®Æ½d³òªºAÄæµ¥®t¼Æ¦C,¥þ§ï¬°1,¦A¥t¦s·sÀÉ,·sÀɦW= CÄ欰¯Á¤Þ-­ìÀɦW
¦]¬°¨C¦¸¥t¦s·sÀÉ,¤º®e¥u·|¦³¤@­Ó¼t°Ó¦WºÙ,©Ò¥Hitem¥u¯à¬O1
¦ý­ìÀɸê®Æ¤£¯àÅܧó,©Ò¦³ªºÀx¦s®æ¤]¤£­n¦³¥ô¦ó§ïÅÜ(¤º¦³¤@¨Ç¤½¦¡)

EX1:²Ä¤@¦¸ C7¬°CHL,«h§R°£¦C8:22,¥t¦s·sÀɦW¬° CHL-(56)CPOMPA1148GP-SOY402
EX2:²Ä¤G¦¸ C8¬°REL,«h§R°£¦C7 & 9:22,¥t¦s·sÀɦW¬° REL-(56)CPOMPA1148GP-SOY402
EX3:³Ì«á¤@¦¸ C21¬°LT,«h§R°£¦C7:20 & 22,¥t¦s·sÀɦW¬° LT-(56)CPOMPA1148GP-SOY402

½Ð°Ý­n¦p¦ó¹F¦¨³o­Ó»Ý¨D?
(56)CPOMPA1148GP-SOY402 ¸ËÂd³qª¾.rar (11.95 KB)

¦^´_ 1# PJChen


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾Ç¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Brr, Crr, V, Y, i&, j&, R, T, Td$, Tn$, G1$
Dim xR As Range, xU As Range, Sh As Worksheet, MyBook, MyPath
Set Y = CreateObject("Scripting.Dictionary")
Set Sh = Sheets("¸ËÂd³qª¾")
Set R = Sh.[D:D].Find("TOTAL", Lookat:=xlWhole)
If Not R Is Nothing Then R = R.Row
Brr = Range(Sh.[A7], Sh.Cells(R - 1, "H"))
For i = 1 To UBound(Brr)
   If Brr(i, 1) = "" Then
      For j = 1 To 8: T = T & Trim(Brr(i, j)): Next
      If T <> "" Then Brr(i, 1) = Brr(i - 1, 1) Else: GoTo i01
   End If
   Y(Brr(i, 1)) = Y(Brr(i, 1)) + 1
   If Y(Brr(i, 1) & "|c") = "" Then Y(Brr(i, 1) & "|c") = Brr(i, 3)
i01: T = "": Next
If Y.Count = 0 Then Exit Sub
G1 = Sh.[G1].Text & Sh.[E1] & "-" & Replace(Replace(Sh.[G2], "/", ""), "#", "") & Sh.[H2]
Td = Format(Now, "YYYY_MM_DD_HH_MM_SS")
Set MyBook = ThisWorkbook
MyPath = MyBook.Path & "\"
If Dir(MyPath & Td, vbDirectory) = "" Then MkDir MyPath & Td
For Each T In Y.KEYS
   If InStr(T, "|") Then GoTo i02
   Sheets("¸ËÂd³qª¾").Copy
   Set xU = Cells(Rows.Count, 1).Resize(1, 8)
   For i = 1 To UBound(Brr)
      If Brr(i, 1) <> T Then
         Set xU = Union(Cells(i + 6, 1).Resize(1, 8), xU)
      End If
   Next
   xU.Delete: [A7] = 1
   Tn = Y(T & "|c") & "-" & G1 & ".xlsx"
   ActiveWorkbook.SaveAs Filename:=MyPath & Td & "\" & Tn, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   ActiveWindow.Close
i02: Next
[A7].Resize(UBound(Brr), 8) = Brr
Set Y = Nothing: Set Sh = Nothing: Erase Brr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 2# Andy2483
±z¦n,
´ú¸Õµ²ªG,°£¤F­ì¥ý¥t¦sªºÀÉ®×¥~,ÁÙ·|²£¥Í¤@­ÓµL¼t°ÓªºªÅÀÉ,¥i§_À°¦£¬Ý¬Ý~~·PÁÂ~~
-(XXX)CPOMPA1148GP-SOY402.rar (11.19 KB)

TOP

¦^´_ 3# PJChen


    ÁÂÁ«e½ú¦^´_
«á¾Ç¥H#1¼Óªº½d¨Ò´Ó¤Jµ{¦¡½X°õ¦æ«á¤£·|²£¥Í#3¼ÓªºÀÉ®×,½Ð«e½ú¦A¸Õ¸Õ¬Ý©Î¤W¶Ç´Ó¤Jµ{¦¡ªº·s­ìÀÉ
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 4# Andy2483

±z¦n,
1..µ{¦¡°õ¦æ¤£¤Óí©w,´ú¸Õ¦n¦h¦¸,¨C¦¸°õ¦æ³£¦³¤£¦Pªºµ²ªG,¦³®Éµ²ªG¬O¥¿±`ªº,¦ý¤j³¡¥÷¤£¥¿±`.
2..[G1]­ì¦³³]©w®æ¦¡,±N(¼Æ¦r)¥]¦b¸Ì­±,·í¥¦¬O¼Æ¦r®É,EX:56ªí­±¤W¬Ý°_¨Ó¬O(56),¹ê»Ú¬O¼Æ¦r56,
³o®É°õ¦æµ{¦¡·|¥X¿ù,¦h¤F¤@­ÓªÅÀÉ-(65)CPOMPA1148GP-SOY402,·í¼Æ¦r¥¼¥X²{®É,·|¥H(XXX)¼È¥N,³o®Éµ{¦¡¥t¦sªºÀɮ׼ƶq´N¥¿±`.

3..¸ê®Æ°Ï¤º,¦³³]©w¦Û°Ê´«¦æ,¦ý¥t¦s·sÀÉ«á,­ì¥»½Õ¾ã¦nªº¦C°ª,·|¦Û°ÊÁY´î
4..¥Î(XXX)´ú¸Õ,¤S¤£¥¿±`,¤@¼Ë·|¥X²{ªÅÀÉ,¦Ó¥B²Ä6¶µ,CÄ椤¨S¦³¥N¸¹,«o§â¥¦¦s¦bªÅÀɤ¤
5..Àɮ׸ê®Æ¤@ª½·|¦³ÅܤÆ,©Ò¥H»Ý­n´ú¸Õ«Ü¦hºØ¼Ò¦¡.
6..§Ú±N¨ä¤¤¤G¦¸µ²ªG,ÀɮפW¶Ç,½ÐÀ°¦£¬d¬Ýµ{¦¡

·PÁ¡I
65.rar (163.98 KB)
XXX.rar (164.35 KB)

TOP

¦^´_ 5# PJChen


    ÁÂÁ«e½ú¦^´_,ÁÂÁ½׾Â
1.¬õ®Ø³BAÄ檺§Ç¸¹¤£¬O¦C§Ç,¦Ó¬O¶µ¥Ø§Ç,©Ò¥H»Ý­n­n¨D«e¤@­Ó¬yµ{key inªÌ­n¦Û«ß
1.1.¤£¸Ó¶ñ¼Æ¦rªº´NªÅ®æ
1.2.¸Ó¶ñ¤Jªº¥¿½T¼Æ¦r­nºë½T¿é¤J

2.«á¤èºñ®Ø³B°Ï°ìªºªÅ¦C¦³¨âºØ¤è¦¡
2.1.key inªÌ­n¦Û«ß§R°£³o¨ÇªÅ¦C
2.2.½Ð«e½ú¥H¤U³sµ²½Ð¬ã¨s¤@¤U,À³¥Î.EntireRow§â¤£­nªº¦C§R°£
https://learn.microsoft.com/zh-t ... loop-to-delete-cell

3.Q:¸ê®Æ°Ï¤º,¦³³]©w¦Û°Ê´«¦æ,¦ý¥t¦s·sÀÉ«á,­ì¥»½Õ¾ã¦nªº¦C°ª,·|¦Û°ÊÁY´î
A:3.1.³o¬O§R°£§½³¡Àx¦s®æ,«á¤èÀx¦s®æ©¹¤W²¾°Ê,²¾°Ê«á»Ý­n°t¦X·í¦C¦C°ª
A:3.2.²³æªº¤è¦¡:¤]¬O¾ã¦C§R°£,½Ð«e½ú¸Õ¸Õ§ï¬Ý

¯¬ ¦¨¥\

¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾Ç¤µ¤Ñ½Æ²ß#2¼Óªº¾Ç²ß¤è®×,¤è®×¤ß±oµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST()
Dim Brr, Crr, V, Y, R, T, i&, j&, Td$, Tn$, G1$
Dim xR As Range, xU As Range, Sh As Worksheet, MyBook, MyPath
'¡ô«Å§iÅܼÆ:(Brr,Crr,V,Y,R,T)¬O³q¥Î«¬ÅܼÆ,(i,j)¬Oªø¾ã¼Æ,(Td,Tn,G1)¬O¦r¦êÅܼÆ
',(xR,xU)¬OÀx¦s®æÅܼÆ,Sh¬O¤u§@ªíÅܼÆ,(MyBook,MyPath)¬O³q¥Î«¬ÅܼÆ

Set Y = CreateObject("Scripting.Dictionary")
'¡ô¥OY³o³q¥Î«¬ÅܼƬO ¦r¨å
Set Sh = Sheets("¸ËÂd³qª¾")
'¡ô¥OSh³oÀx¦s®æÅܼƬO ¦W¬°"¸ËÂd³qª¾"ªº¤u§@ªí
Set R = Sh.[D:D].Find("TOTAL", Lookat:=xlWhole)
'¡ô¥OR³o³q¥Î«¬ÅܼƬO ¥HRange.Find¤èªk§äDÄ椤Àx¦s®æ­È¬O¥þ¦P "TOTAL"¦r¦ê
'https://learn.microsoft.com/zh-tw/office/vba/api/excel.range.find

If Not R Is Nothing Then R = R.Row Else Exit Sub
'¡ô¦pªGRÅܼƧä¨ìÀx¦s®æ!´N¥OR³oÅܼƴ«¸ËRÅܼÆ(Àx¦s®æ)ªº¦C¸¹,
'§_«h´Nµ²§ôµ{¦¡°õ¦æ

Brr = Range(Sh.[A7], Sh.Cells(R - 1, "H"))
'¡ô¥OBrr³o³q¥Î«¬ÅܼƬO ¤Gºû°}¦C,¥H[A7]¨ìHÄæ(RÅܼÆ-1)¦CÀx¦s®æ­È±a¤J
For i = 1 To UBound(Brr)
'¡ô³]¶¶°j°é!i±q1¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
   If Brr(i, 1) = "" Then
   '¡ô¦pªGi°j°é¦C²Ä1ÄæBrr°}¦C­È¬O ªÅ¦r¤¸
      For j = 1 To 8: T = T & Trim(Brr(i, j)): Next
      '¡ô³]¶¶°j°é!j±q1¨ì 8,¥OT³o¦r¦êÅܼƬO¦Û¨­³s±µ,
      '(i°j°é¦Cj°j°éÄæBrr°}¦C­È)¥h°£ÀY§ÀªÅ¥Õ¦r¤¸«á²Õ¦¨ªº·s¦r¦ê

      If T <> "" Then Brr(i, 1) = Brr(i - 1, 1) Else: GoTo i01
      '¡ô¦pªGTÅܼƤ£¬OªÅ¦r¤¸!´N¥Oi°j°é¦C²Ä1ÄæBrr°}¦C­È¬O¤W¤@¦C°}¦C­È
      '§_«h´N¸õ¨ìi01¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ

   End If
   Y(Brr(i, 1)) = Y(Brr(i, 1)) + 1
   '¡ô¥Oi°j°é¦C²Ä1ÄæBrr°}¦C­È·íkey,item¬Oitem¦Û¨­²Ö¥[1
   If Y(Brr(i, 1) & "|c") = "" Then Y(Brr(i, 1) & "|c") = Brr(i, 3)
   '¡ô¦pªG¥Oi°j°é¦C²Ä1ÄæBrr°}¦C­È·íkey¬dY¦r¨å±oitem­È¬O ªÅ¦r¤¸?
   '´N¥O¥Oi°j°é¦C²Ä1ÄæBrr°}¦C­È³s±µ "|c"«áªº·s¦r¦ê·íkey,item¬Oi°j°é¦C²Ä3ÄæBrr°}¦C­È

i01: T = "": Next
If Y.Count = 0 Then Exit Sub
'¡ô¦pªGY¦r¨åkeyªº­Ó¼Æ¬O 0­Ó!´Nµ²§ôµ{¦¡°õ¦æ
G1 = Sh.[G1].Text & Sh.[E1] & "-" & Replace(Replace(Sh.[G2], "/", ""), "#", "") & Sh.[H2]
'¡ô¥OG1³o¦r¦êÅܼƬO [G1]Àx¦s®æÅé²{ªº¦rÂন¤å¦r ³s±µ[E1]Àx¦s®æ­È,³s±µ"-",
'¦A³s±µ([G2]Àx¦s®æ¥h°£"/"¦r¤¸»P"#"¦r¤¸),³Ì«á³s±µ[H2]Àx¦s®æ­È

Td = Format(Now, "YYYY_MM_DD_HH_MM_SS")
'¡ô¥OTd³o¦r¦êÅܼƬO ²{¦b®É¶¡Âন¤å¦r
Set MyBook = ThisWorkbook
'¡ô¥OMyBook³o³q¥Î«¬ÅܼƬO ¥»¬¡­¶Ã¯
MyPath = MyBook.Path & "\"
'¡ô¥OMyPath³o³q¥Î«¬ÅܼƬO ¥»¬¡­¶Ã¯¸ô®| ³s±µ"\"«áªº·s¦r¦ê
MkDir MyPath & Td
'¡ô¥O²£¥Í¤@­Ó¸ê®Æ§¨,¦W¦r¬O TD,¸ô®|¦bMyPath
For Each T In Y.KEYS
'¡ô³]³v¶µ°j°é!¥OTÅܼƬO Y¦r¨å¸Ìªº¤@­Ókey
   If InStr(T, "|") Then GoTo i02
   '¡ô¦pªGTÅܼƸ̦³¥]§t"|"¦r¤¸!´N¸õ¨ìi02¼Ð¥Ü¦ì¸mÄ~Äò°õ¦æ
   Sh.Copy
   '¡ô¥OShÅܼÆ("¸ËÂd³qª¾"¤u§@ªí)½Æ»s¨ì·s¶}ªº¬¡­¶Ã¯
   Set xU = Cells(Rows.Count, 1).Resize(1, 8)
   '¡ô¥OxU³oÀx¦s®æÅܼƬO¥»ªíAÄæ³Ì«á¦CÀx¦s®æ,¦V¥kÂX®i8®æ½d³òªºÀx¦s®æ
   For i = 1 To UBound(Brr)
   '¡ô¥O³]¶¶°j°é!i±q1¨ì Brr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
      If Brr(i, 1) <> T Then
      '¡ô¦pªGi°j°é¦C²Ä1ÄæBrr°}¦C­È »P ÅܼƤ£¦P?
         Set xU = Union(Cells(i + 6, 1).Resize(1, 8), xU)
         '¡ô¥OxUÅܼÆÄ~Äò¥HUnion()¤èªk¯Ç¤J¤£­nªºÀx¦s®æ
      End If
   Next
   xU.Delete: [A7] = 1
   '¡ô¥OxUÅܼÆ(Àx¦s®æ)§R°£,¥O[A7]Àx¦s®æ­È¬O 1
   Tn = Y(T & "|c") & "-" & G1 & ".xlsx"
   '¡ô¥OTn³o¦r¦êÅÜ¼Æ ¬O²Õ¦X¦U¥²­nÅܼƲզ¨ªº·s¦r¦ê
   ActiveWorkbook.SaveAs Filename:=MyPath & Td & "\" & Tn, _
        FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
   '¡ô¥OÀÉ®×¨Ì «ü©w¦ì¸m «ü©wÀɦW Àx¦s
   ActiveWindow.Close
   '¡ôÃö³¬ÀÉ®×
i02: Next
Set Y = Nothing: Set Sh = Nothing: Erase Brr
'¡ô¥OÄÀ©ñÅܼÆ
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

AÄæ§Ç¸¹ªÅ¥Õ, ¦ýHÄæ³Æµù¦³¤º®e, ºâ¤W¤@­Ó§Ç¸¹ªº, ­n¤@°_½Æ»s???
µo©«³Ì¦n­n°µ´X­Ó»Ý¨Dµ²ªG¨Ò¤l, ¥ú¾Ì¤@°ï¤å¦r»¡©ú¬ÝµÛ²Ö~~

TOP

°õ¦æµ{¦¡«e, ­n¦Û¤v¥ýÀˬd¤@¤U¸ê®Æ, ±N¸ê®Æ¸É»ô, ¨Ã§â¤£­nªº¦æ¥ý§R°£,
¤£­n¤S¨Ó°Ýµ{¦¡¦³°ÝÃD~~µ{¦¡¥u­t³d³B²z¥¿½Tªº¸ê®Æ

Test(¸ËÂd³qª¾)-1.rar (18.41 KB)

TOP

¦^´_ 9# ­ã´£³¡ªL
­ã¤j¦n,

¦P¤@Àx¦s®æ³¡¥÷§ïÅÜÃC¦âªº¦r,¥t¦s·sÀÉ«á,·|Åܦ¨¶Â¦â,
½Ð°Ý­n«ç»ò«O«ù­ì®æ¦¡?

§Ú±N´ú¸Õ¦³°ÝÃDªºÀÉPO¤W,½ÐÀ°¦£¬Ý¤U~~ ¥t¦s·sÀÉ´ú¸Õ.rar (53.05 KB)

TOP

        ÀR«ä¦Û¦b : ¯à¥I¥X·R¤ß´N¬OºÖ¡A¯à®ø°£·Ð´o´N¬O¼z¡C
ªð¦^¦Cªí ¤W¤@¥DÃD