[µo°Ý] ¿ë»{¤Î¶×Á`

198188

¤U¸ü (91.75 KB)

2024-3-6 12:02

¤U¸ü (65.35 KB)

2024-3-6 12:03

¦³ ¤u§@ªí 1 - 4
¦p¤W¹ÏÁ|¨Ò

1. ¤u§@ªí Total  "¬[¸¹"  ¡]ÄæA ¹ïÀ³¤u§@ªí1¡AÄæG ¹ïÀ³¤u§@ªí2¡AÄæM ¹ïÀ³¤u§@ªí3¡AÄæS¹ïÀ³¤u§@ªí4¡^
¶¶§ÇŪ¥X¤u§@ªí 1 - 4 ªº A Ä渹½X  ¡]¤£­n­«½Æ¼Æ¾Ú¡^

2.  ¤u§@ªí Total  "¤uµ{"  ¡]ÄæB ¹ïÀ³¤u§@ªí1¡AÄæH ¹ïÀ³¤u§@ªí2¡AÄæN¹ïÀ³¤u§@ªí3¡AÄæT¹ïÀ³¤u§@ªí4¡^
®Ú¾Ú¬[¸¹Åª¨ú¤u§@ªí 1 - 4 ªº M Äæ ¡]§R°£­«½Æ¸ê®Æ, Á|¨Ò (BF, BF Åã¥ÜBF) (BF, BH, BF, BH Åã¥ÜBF/BH)

3. ¤u§@ªí Total  "¼t"  ¡]Äæ C/D ¹ïÀ³¤u§@ªí1¡AÄæ I/J ¹ïÀ³¤u§@ªí2¡AÄæ O/P ¹ïÀ³¤u§@ªí3¡AÄæ U/V ¹ïÀ³¤u§@ªí4¡^
®Ú¾Ú¬[¸¹Åª¨ú¤u§@ªí 1 - 4 ªº N / O Äæ ( N Äæ ¹ïÀ³ C / I / O / UÄæ,  O Äæ ¹ïÀ³ D / J / P / VÄæ)
¦pªGNÄæ内Åã¥Ü¡§¼Qªo¡¨ or  ¤£µ¥©óªÅ®æ¡A C / I / O / UÄæÅã¥Ü "KH" («ö·Ó¤u§@ªí¨Ó¤À°tÄæ¦ì¡^
¦pªGOÄæ内Åã¥Ü¡§¼Qªo¡¨ or  ¤£µ¥©óªÅ®æ¡A D / J / P / VÄæÅã¥Ü "KP"  («ö·Ó¤u§@ªí¨Ó¤À°tÄæ¦ì¡^
¦pªGN/OÄæ内 ³£¬OªÅ®æ¡A  C / I / O / UÄæÅã¥Ü "KH" («ö·Ó¤u§@ªí¨Ó¤À°tÄæ¦ì¡^

4. ¤u§@ªí Total  "³B²z"  ¡]ÄæE ¹ïÀ³¤u§@ªí1¡AÄæK ¹ïÀ³¤u§@ªí2¡AÄæQ¹ïÀ³¤u§@ªí3¡AÄæW¹ïÀ³¤u§@ªí4¡^
®Ú¾Ú¬[¸¹Åª¨ú¤u§@ªí 1 - 4 ªº N Äæ / O Äæ ,
¦pªG¥ô¦ó¤@®æ¦³¡§¼Qªo¡¨ ¡A¤u§@ªíTotal Åã¥Ü¡§¼Qªo¡¨,
¦pªG¥þ³¡³£¬OªÅ®æ¡A¤u§@ªíTotal Åã¥Ü "-"

198188

¦^´_ 12# Andy2483


    ½Ð°Ý³o¥y¥[¦b­þ­Ó¦ì¸m

Andy2483

¦^´_ 11# 198188

Sub Total()
~~
   Brr = Sheets(s).[A1].CurrentRegion: If Not IsArray(Brr) Then GoTo s01 Else ReDim Crr(1 To UBound(Brr), 1 To 5)
   '¡ô¥OBrrÅܼƬO¼g¤J°Ï°ìÀx¦s®æ­Èªº¤Gºû°}¦C,¦pªGBrr¤£¬O°}¦C´N¸õ¨ì¼Ð¥Üs01¦ì¸mÄ~Äò°õ¦æ,§_«h«Å§iCrrÅܼƬO¤GºûªÅ°}¦C
   ~~
s01: Next
End Sub

198188

¦^´_ 9# Andy2483
§ï爲³o­Ó¤§«á¡A¦pªG¤£¬O¥|­ÓÂd³£¦³¸ê®Æªº¸Ü¡A¨º麽·|Åã¥ÜERROR "1004" À³¥Îµ{¦¡©Îª«¥ó©w¸q¤WOI*.

      xT.Copy xR(-1): xR(-1) = "No." & Sheets(s).Name
   '¡ô¥O¼ÐÃDÀx¦s®æ½Æ»s¨ì¥Ø¼Ð®æ,¥O¼ÐÃD®æ¼g¤J¤u§@ªí¦W
   With xR.Resize(N, 5)
      .Value = Crr
      .Borders.LineStyle = 1
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Columns(3).Font.ColorIndex = 3
      .Columns(4).Font.ColorIndex = 5
      .Font.Bold = True
   End With '¦¹¬q¬O¥OÂX®i¾A¶qÀx¦s®æ½d³ò¥HCrr°}¦C­È¼g¤J,¨Ã½Õ¾ã¸Ó½d³ò®æ¦¡
   N = 0: Z.RemoveAll: Set xR = xR(1, 7)
   '¡ô¥ONÅܼÆÂk¹s,Z¦r¨å²MªÅ,¥OxRÅܼƥk²¾¨ì¦Û¨­¶}©lªº²Ä7®æ
Next

198188

¦^´_ 9# Andy2483


    ÁÂÁ«e½ú«üÂI

Andy2483

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«­×­q¤è®×½Æ²ßµù¸Ñ¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub Total()
Dim Arr, Brr, Crr, Z, i&, N&, R&, s%, T$, A$, xR As Range, xT As Range
'¡ô«Å§iÅܼÆ:&¬Oªø¾ã¼Æ,%¬Oµu¾ã¼Æ,¨S¦³«ü©wªº¬O³q¥Î«¬ÅܼÆ
Set Z = CreateObject("Scripting.Dictionary")
'¡ô¥OZÅܼƬO ¦r¨å
With Sheets("Total").UsedRange
   .Offset(2).EntireRow.Delete
   .Offset(, 5).EntireColumn.Delete
   Set xT = .Item(1).Resize(2, 5): Set xR = .Item(3, 1): A = [KP!C1]
End With '¦¹¬q¬O¯d¤U¤@­Ó¼ÐÃDÀx¦s®æ,¨ä¾l¸ê®ÆÄæ/¦C§R°£
For s = 1 To 4
'¡ô³]¶¶°j°é!¥OsÅܼƱq1 ¨ì4
   Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
   '¡ô¥OBrrÅܼƬO¼g¤J°Ï°ìÀx¦s®æ­Èªº¤Gºû°}¦C,«Å§iCrrÅܼƬO¤GºûªÅ°}¦C
   For i = 2 To UBound(Brr)
   '¡ô³]¶¶°j°é!¥OiÅܼƱq2 ¨ìBrr°}¦CÁa¦V³Ì¤j¯Á¤Þ¦C¸¹
      If Brr(i, 1) <> T And Brr(i, 1) <> "" Then T = Brr(i, 1)
      If Not IsNumeric(T) Or Brr(i, 13) = "" Then GoTo i01 Else R = Z(T)
      If R = 0 Then N = N + 1: R = N: Crr(R, 1) = T: Crr(R, 2) = Brr(i, 13): Z(T) = N
      If InStr("/" & Crr(R, 2) & "/", "/" & Brr(i, 13) & "/") = 0 Then Crr(R, 2) = Crr(R, 2) & "/" & Brr(i, 13)
      If Brr(i, 15) <> "" Then Crr(R, 4) = "KP"
      If Brr(i, 14) <> "" Or (Brr(i, 14) = "" And Brr(i, 15) = "") Then Crr(R, 3) = "KH"
      If Brr(i, 14) = A Or Brr(i, 15) = A Then Crr(R, 5) = A
      If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> A Then Crr(R, 5) = "-"
i01: Next '¦¹¬q¬O¨Ì±ø¥ó±Nµ²ªG¼g¤JCrr°}¦C¤¤
   xT.Copy xR(-1): xR(-1) = "No." & Sheets(s).Name
   '¡ô¥O¼ÐÃDÀx¦s®æ½Æ»s¨ì¥Ø¼Ð®æ,¥O¼ÐÃD®æ¼g¤J¤u§@ªí¦W
   With xR.Resize(N, 5)
      .Value = Crr
      .Borders.LineStyle = 1
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlCenter
      .Columns(3).Font.ColorIndex = 3
      .Columns(4).Font.ColorIndex = 5
      .Font.Bold = True
   End With '¦¹¬q¬O¥OÂX®i¾A¶qÀx¦s®æ½d³ò¥HCrr°}¦C­È¼g¤J,¨Ã½Õ¾ã¸Ó½d³ò®æ¦¡
   N = 0: Z.RemoveAll: Set xR = xR(1, 7)
   '¡ô¥ONÅܼÆÂk¹s,Z¦r¨å²MªÅ,¥OxRÅܼƥk²¾¨ì¦Û¨­¶}©lªº²Ä7®æ
Next
End Sub

198188

¦^´_ 7# Andy2483

ÁÂÁ«e½ú«üÂI¡A²Å¦X¨ì½d¨Ò­n¨D¡A¥Ñ©ó¤¤¤å²ÁcÅé°ÝÃD¡A©Ò¥H§Ú°µ¤F¥H¤U½Õ¾ã¡C

    Option Explicit
Sub Total()
Dim Brr, Crr, Z, i&, N&, R&, s%, T$, xR As Range
Dim a, b As Integer
Set Z = CreateObject("Scripting.Dictionary")
Sheets("Total").Range([W3], [A65536].End(xlUp)(3)).Delete Shift:=xlUp: Set xR = [Total!A3]

For s = 1 To 4
   Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
   For i = 2 To UBound(Brr)
      If Brr(i, 1) <> T And Brr(i, 1) <> "" Then T = Brr(i, 1)
      If Not IsNumeric(T) Or Brr(i, 13) = "" Then GoTo i01 Else R = Z(T)
      If R = 0 Then N = N + 1: R = N: Crr(R, 1) = T: Crr(R, 2) = Brr(i, 13): Z(T) = N
      If InStr("/" & Crr(R, 2) & "/", "/" & Brr(i, 13) & "/") = 0 Then Crr(R, 2) = Crr(R, 2) & "/" & Brr(i, 13)
      If Brr(i, 15) <> "" Then Crr(R, 4) = "KP"
      If Brr(i, 14) <> "" Or (Brr(i, 14) = "" And Brr(i, 15) = "") Then Crr(R, 3) = "KH"
      If Brr(i, 14) = Sheets("KP").Range("C1") Or Brr(i, 15) = Sheets("KP").Range("C1") Then Crr(R, 5) = Sheets("KP").Range("C1")
      If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> Sheets("KP").Range("C1") Then Crr(R, 5) = "-"
i01: Next
xR.Resize(N, 5) = Crr: xR(-1) = "No." & Sheets(s).Name
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
Next

a = Cells(Rows.Count, 1).End(3).Row

With Range("A3", "E" & a)
     .Borders.LineStyle = 1
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlCenter
End With

a = Cells(Rows.Count, 7).End(3).Row

With Range("G3", "K" & a)
     .Borders.LineStyle = 1
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlCenter
End With

a = Cells(Rows.Count, 13).End(3).Row

With Range("M3", "Q" & a)
     .Borders.LineStyle = 1
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlCenter
End With

a = Cells(Rows.Count, 19).End(3).Row

With Range("S3", "W" & a)
     .Borders.LineStyle = 1
     .HorizontalAlignment = xlCenter
     .VerticalAlignment = xlCenter
End With


End Sub

Andy2483

¦^´_ 6# 198188

¥H¤U¬O¾Ç²ß°}¦C»P¦r¨åªº¤è®×,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Brr, Crr, Z, i&, N&, R&, s%, T$, xR As Range
Set Z = CreateObject("Scripting.Dictionary")
Sheets("Total").UsedRange.ClearContents: Set xR = [Total!A3]
For s = 1 To 4
   Brr = Sheets(s).[A1].CurrentRegion: ReDim Crr(1 To UBound(Brr), 1 To 5)
   For i = 2 To UBound(Brr)
      If Brr(i, 1) <> T And Brr(i, 1) <> "" Then T = Brr(i, 1)
      If Not IsNumeric(T) Or Brr(i, 13) = "" Then GoTo i01 Else R = Z(T)
      If R = 0 Then N = N + 1: R = N: Crr(R, 1) = T: Crr(R, 2) = Brr(i, 13): Z(T) = N
      If InStr("/" & Crr(R, 2) & "/", "/" & Brr(i, 13) & "/") = 0 Then Crr(R, 2) = Crr(R, 2) & "/" & Brr(i, 13)
      If Brr(i, 15) <> "" Then Crr(R, 4) = "KP"
      If Brr(i, 14) <> "" Or (Brr(i, 14) = "" And Brr(i, 15) = "") Then Crr(R, 3) = "KH"
      If Brr(i, 14) = "¼Qªo" Or Brr(i, 15) = "¼Qªo" Then Crr(R, 5) = "¼Qªo"
      If Brr(i, 14) = "" And Brr(i, 15) = "" And Crr(R, 5) <> "¼Qªo" Then Crr(R, 5) = "-"
i01: Next
xR.Resize(N, 5) = Crr: xR(0).Resize(, 5) = [{"¬[¸¹","¤uµ{","¼t","","³B²z"}]: xR(-1) = Sheets(s).Name & "Âd"
N = 0: Z.RemoveAll: Set xR = xR(1, 7)
Next
End Sub

198188

¦^´_ 5# Andy2483


   ²Ä2Âd
¬[¸¹ 134 ¡A 136¡A 148¡A 149¡A 150 ¦b厰ªº¦ì¸mÀ³¸ÓÅã¥Ü "KH" ¤~¹ï¡Cªþ¤W§ó·sªº½d¨Ò¡C

Andy2483

¦^´_ 1# 198188

³W«h:¦pªGN/OÄæ内 ³£¬OªÅ®æ¡A  C / I / O / UÄæÅã¥Ü "KH" («ö·Ó¤u§@ªí¨Ó¤À°tÄæ¦ì¡^
½Ð±Ð¬[¸¹ 148ªº¼tI ¬OKH ÁÙ¬OªÅ®æ??