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

¥X³f³æ«Ø¥ß

¦U¦ì«e½ú¦n
¤µ¤Ñ«á¾Ç½m²ß¥H¦r¨å»P°}¦C°µ²Î­p,¨Ã¤gªk·Ò¿û²£¥Í¹Ïªí
½Ð¦U¦ì«e½ú«ü¥¿¨Ã«ü¾É

­ì©l¸ê®Æ:


²£¥Í·sÀɮ׹Ϫí:


Option Explicit
Sub «È¤á¥X³fª÷ÃB_²Î­p¹Ïªí()
Application.ScreenUpdating = False
'¡ô°õ¦æ®É¿Ã¹õµe­±¤£­n¸òµÛÅÜ°Ê

Dim Yrr, i&, xD, Arr, Brr, d
'¡ô«Å§iÅܼÆ

Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å

Yrr = [¥X³f¸ê®Æ!A1].CurrentRegion.Offset(1, 0)
'¡ô¥O "¥X³f¸ê®Æªí"([A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,
'ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³ò,©¹¤U°¾²¾¤@¦C )­È¬O°}¦C Yrr


For i = 1 To UBound(Yrr)
'¡ô³]°j°é±N«È¤á¦W§Q¥Î¦r¨å¥h°£­«½Æ¨Ã²Ö¥[ GÄ檺ª÷ÃB
   If Yrr(i, 1) <> "" Then
      d = Yrr(i, 1)
      xD(d) = xD(d) + Yrr(i, 7)
   End If
Next

Arr = Application.Transpose(xD.keys)
'¡ô¥OArr ¬O¦r¨åkeyÂà¸m¤§«áªº¤Gºû°}¦C

Brr = Application.Transpose(xD.Items)
'¡ô¥OBrr ¬O¦r¨åItemÂà¸m¤§«áªº¤Gºû°}¦C

Workbooks.Add
'¡ô¶}±Ò¤@­Ó·sÀÉ®×

[A1] = "«È¤á"
[B1] = "¥X³fª÷ÃB²Î­p(NT)"
[A2].Resize(UBound(Arr), 1) = Arr
'¡ô±N Arr°}¦C±q[A2]¶K¤J­È

[B2].Resize(UBound(Brr), 1) = Brr
'¡ô±N Brr°}¦C±q[B2]¶K¤J­È

[A1].CurrentRegion.Sort _
KEY1:=[B1], Order1:=xlDescending, Header:=xlYes
'¡ô¸ê®Æ¦³©ïÀY¦Cªºº¥´î±Æ§Ç

ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("¹Ïªí 1")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
End With
[A1].Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlPieExploded
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("¹Ïªí 2")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
   .IncrementTop 400
End With
ActiveSheet.ChartObjects("¹Ïªí 2").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.ShowPercentage = True
Selection.Position = xlLabelPositionOutsideEnd
'¡ô¿ý»s¥¨¶°´N¥i¥H²£¥Í³o¨â­Ó¹Ïªí!µø»Ý¨D½Õ¾ã!

[A1].Activate
Set xD = Nothing
Set Arr = Nothing
Set Brr = Nothing
End Sub

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2022-10-17 08:13 ½s¿è

¦U¦ì«e½ú¦n
¤µ¤Ñ¹B¥Î¦¹½d¨Ò¾ã²z¤F:
1.¸ê®Æªí¬Ý¨ì­þ¸Ì!·Æ¹«¥ªÁä§Ö«ö¨â¤U´N¿z¿ï
2.©ïÀY¦C®æ§Ö«ö¨â¤U´N¥þ³¡Åã¥Ü

¿z¿ï«eºu°Ê¨÷¶bÀH¾÷¬d¬Ý¸ê®Æ:


¬Ý¨ì·Q¿z¿ïªºÃöÁä¦r!´N¥ªÁä§ÖÀ»¨â¦¸


¥ªÁä§ÖÀ»¨â¦¸«áªºµ²ªG:


·Q§Ö³t¥þ³¡Åã¥Ü!´N«ö©ïÀY¦CA1Àx¦s®æ:


¥H¤Uµ{¦¡½X¤ß±oµù¸Ñ¨Ñ°Ñ¦Ò,½Ð¦U¦ì«e½ú¥u¥¿¨Ã«ü¾É!

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim V$
With Target
'¡ô¥H¤U¬O¦³Ãö©ó¥ªÁäÂùÀ»¨Æ¥óªºµ{§Ç

   If .Address = "$A$1" Then
   '¡ô¦pªG¥ªÁäÂùÀ»ªº¦ì§}¬O "$A$1"
   
      If ActiveSheet.AutoFilter Is Nothing Then
      '¡ô¦pªG¤u§@ªí¨S¦³¨Ï¥Î¿z¿ï
      
         [A1].AutoFilter
         '¡ô¥O [A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³ò
         ',ªº²Ä¤@¦C³]©w¿z¿ï

         
         Else
         '¡ô§_«h ¦pªG¤u§@ªí¦³¨Ï¥Î¿z¿ï
         
            If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
            '¡ô¦pªG¤u§@ªí¬O¦b¿z¿ï¤¤! ´NÅã¥Ü¥þ³¡¸ê®Æ
            
      End If
      Cancel = True
   End If
   If .Column = [A1].Column And .Row > 1 Then
   '¡ô¦pªG¥ªÁäÂùÀ»¬O AÄæ ¦Ó¥B¬O¤j©ó²Ä¤@¦C
   
      V = Trim(.Value)
      '¡ô¥OV¥ªÁäÂùÀ»®æ¸ÌÀY§À¥hªÅ¥Õ¦r¤¸ªº¦r¦ê
      
      If Trim(.Value) = "" Then
      '¡ô¦pªG¥ªÁäÂùÀ»®æªº­È(¥h°£ÀY§ÀªºªÅ¥Õ¦r¤¸)¤§«á,¬OªÅ¦r¤¸
        
         Cancel = True
         '¡ô¨ú®ø¨Æ¥óªº°õ¦æ
         
         Exit Sub
         '¡ôµ²§ô¦¹µ{¦¡°õ¦æ
         
      End If
      If ActiveSheet.AutoFilter Is Nothing Then
      '¡ô¦pªG¤u§@ªí¨S¦³¨Ï¥Î¿z¿ï
      
         [A1].AutoFilter
         '¡ô¥O [A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³ò
         ',ªº²Ä¤@¦C³]©w¿z¿ï
         
         Else
         '¡ô§_«h ¦pªG¤u§@ªí¦³¨Ï¥Î¿z¿ï
         
            If ActiveSheet.FilterMode = True Then ActiveSheet.ShowAllData
            '¡ô¦pªG¤u§@ªí¬O¦b¿z¿ï¤¤! ´NÅã¥Ü¥þ³¡¸ê®Æ
            
      End If
      Selection.AutoFilter Field:=1, Criteria1:=V
      '¡ô²Ä¤@Äæ°õ¦æ¿z¿ï!¿z¿ïªºÃöÁä¦r´N¬OÂùÀ»³o®æªº¥hÀY¥h§À¦r¦ê
      
      ActiveWindow.ScrollColumn = 1
      '¡ô¿Ã¹õµe­±±²¨ì³Ì¥ªÃä
      
      'ActiveWindow.ScrollRow = 1
      '¡ô¿Ã¹õµe­±±²¨ì³Ì¤W­±
      
      Cancel = True
      '¡ô¨ú®ø¨Æ¥óªº°õ¦æ
      
   End If
End With
End Sub

TOP

¦^´_ 32# Andy2483
°ª¤â¡A³£¬O¤@ª½µL¤îºÉªº¶i¨B
ÁÙ¦³«Ü¦h¦a¤è­n»P°ª¤â¾Ç²ß:)

TOP

¦^´_ 33# cclo0728
ÁÂÁ«e½ú¦^ÂÐ
¾Ç²ß¬O¤@¥ó«Ü¦³·N«äªº¨Æ
http://forum.twbts.com/thread-387-1-1.html
¥H¤W³o©«¾Ç²ß¨ìªº¤èªkÀ³¥Î¦b«e½úªº½d¨Ò¤W:
test_1_20221021.zip (61.49 KB)

¦pªG«ö¶s¦h¤F!¥i¥H¥Îµæ³æ«ö¶s³B²z¤@¤U!


«ö¶s«á:

TOP

¾Ç²ß¨ì¤F!À³¥Î¤W¤F!¯d¤U¨¬¸ñ!ÁÙ·í§@°µµ§°O!
¦h¦~¥H«á¦A¦^¨Ó³o©«¬Ý¬Ý¦Û¤v¾Çªº¤Ó¤Ö!
·s¼W¥\¯à«ö¶s:


µ²ªG1:


µ²ªG2,3:

TOP

¦U¦ì«e½ú¦­¦w
¤µ¦­±N²Î­p¹Ïªí»P¤ÀÃþ·J¾ã¥[¤J¤F¤é´Á°Ï¶¡ªº³]©w¥\¯à!
½Ð¦U¦ì«e½ú¤£§[«ü±Ð!
test_1_20221026_1.zip (72.46 KB)

1.¥i¦b¬õ¦â®Ø³B¶ñ¤J¤é´Á
2.¦pªG°_©l¤é¨S¶ñ!§ì¸ê®Æ³Ì¤p¤é´Á
3.¦pªGµ²§ô¤é¨S¶ñ!§ì¸ê®Æ³Ì¤j¤é´Á
4.³£¨S¶ñ!¦U§ì¸ê®Æ³Ì¤p¤é´Á&§ì¸ê®Æ³Ì¤j¤é´Á

TOP

¹ÏªíÅܧó¦p¤U:



·J¾ã¤ÀÃþÅܧó¦p¤U:


TOP

¥D­nµ{¦¡½XÅܧó¦p¤U:
Option Explicit
Public Dats As Date, Datn As Date, AC_WO_NA
'¡ô³]¬°¥þ°ìÅܼÆ!µ¹¦U¹B¥Î¦¹°Æµ{¦¡ªº¥Dµ{¦¡¹B¥Î
Sub ªø§Ç¸¹Âà_¤é´Á_µu§Ç¸¹()
Dim Arr, i&, xB, N&, D1 As Date, TTT
'¡ô«Å§iÅܼÆ:D1 ¬O¤é´Á,N¬O¼Æ¦r
Set xB = Sheets("¥X³f¸ê®Æ")
'¡ô¥OxB¬O "¥X³f¸ê®Æ" ¤u§@ªí
Dats = 0
'¡ô°_©l¤éÂk¹s
Datn = 0
'¡ôµ²§ô¤éÂk¹s
If IsDate(xB.[I1]) Then
'¡ô¦pªG ¥X³f¸ê®Æªíªº[I1]¬O¤é´Á
   Dats = xB.[I1]
   '¡ô°_©l¤é´N¸Ë¤J³o¤é´Á
End If
If IsDate(xB.[J1]) Then
'¡ô¦pªG ¥X³f¸ê®Æªíªº[J1]¬O¤é´Á
   Datn = xB.[J1]
   '¡ôµ²§ô¤é´N¸Ë¤J³o¤é´Á
End If
Arr = xB.Range(xB.[J1], Cells(xB.UsedRange.EntireRow.Count, 1))
'¡ô¥OArr¬O"¥X³f¸ê®Æ" ¤u§@ªí A:GÄ椧¶¡¦³¨Ï¥Î¦Cªº°Ï°ìÀx¦s®æ­È
For i = 2 To UBound(Arr)
'¡ô³]°j°é©î¸ÑBÄ檺ªø§Ç¸¹
   D1 = "20" & Mid(Arr(i, 2), 1, 2) & "/" & Mid(Arr(i, 2), 3, 2) & "/" & Mid(Arr(i, 2), 5, 2)
   '¡ô "20",¥[ªø§Ç¸¹²Ä1­Ó¦r¶}©l¨ú¨â¦r¤¸="22"
   ',¦A¥[ªø§Ç¸¹²Ä3­Ó¦r¶}©l¨ú¨â¦r¤¸="10"
   ',¦A¥[ªø§Ç¸¹²Ä5­Ó¦r¶}©l¨ú¨â¦r¤¸="08"
   'D1="2022/10/08"¦r¦êÂà¤Æ¬°¤é´Á,¦]D1«Å§i¬°¤é´Á
   Arr(i, 9) = D1
   '¡ô§âD1¤é´Á©ñ¤JArrªº²Ä9Äæ¦ì¸m
   N = Right(Arr(i, 2), 3)
   '¡ô¥ON¬O±`§Ç¸¹ªº¥kÃä3­Ó¦r¤¸¦r¦êÂà¼Æ¦r,¦]N«Å§i¬°¼Æ¦r
   Arr(i, 10) = N
   '¡ô§âN¼Æ¦r©ñ¤JArrªº²Ä10Äæ¦ì¸m
Next
Workbooks.Add
'¡ô¶}¤@­Ó·sªºÀÉ®×
AC_WO_NA = ActiveWorkbook.Name
Sheets(1).Name = "¥X³f¸ê®Æ"
[A1].Resize(UBound(Arr), 10) = Arr
'¡ô§âArr°}¦Cªº¸ê®Æ±q[A1]¶}©l­Ë¤J·s¤u§@ªíªº¦s®æ
If Datn = 0 Then
'¡ô¦pªGµ²§ô¤é¬OÂk¹sª¬ºA?
   Datn = CDate(WorksheetFunction.Max([I:I]))
   '¡ô±ø¥ó¦¨¥ß!´N§ì[I:I]¸Ìªº³Ì¤j¤é´Á¸Ë¶iµ²§ô¤é
End If
If Dats = 0 Then
'¡ô¦pªG°_©l¤é¬OÂk¹sª¬ºA?
   Dats = CDate(WorksheetFunction.Min([I:I]))
   '¡ô±ø¥ó¦¨¥ß!´N§ì[I:I]¸Ìªº³Ì¤p¤é´Á¸Ë¶i¶}©l¤é
End If
[I1] = "¥X³f¤é´Á"
[J1] = "·í¤é§Ç¸¹"
Cells.Columns.AutoFit
'¡ô¦Û°Ê½Õ¾ãÄæ¼e
Cells.Rows.AutoFit
'¡ô¦Û°Ê½Õ¾ã¦C°ª
[2:2].Select
ActiveWindow.FreezePanes = True
'¡ô²Ä¤G¦C¥H¤WÀx¦s®æ­áµ²µ¡®æ
[A1].Select
[A1].AutoFilter
'¡ô³]©w¿z¿ï
Cells.Borders.LineStyle = xlContinuous
'¡ôÅã¥Ü®æ½u
End Sub

Option Explicit
Sub «È¤á¥X³fª÷ÃB_²Î­p¹Ïªí()
Application.ScreenUpdating = False
'¡ô°õ¦æ®É¿Ã¹õµe­±¤£­n¸òµÛÅÜ°Ê
Call ªø§Ç¸¹Âà_¤é´Á_µu§Ç¸¹

Dim Yrr, i&, xD, Arr, Brr, d, c, R
'¡ô«Å§iÅܼÆ
Set xD = CreateObject("Scripting.Dictionary")
'¡ô¥OxD¬O¦r¨å
Set Yrr = [¥X³f¸ê®Æ!A1].CurrentRegion
'¡ô¥O Yrr¬O [A1]¬Û¾F«DªÅ®æ©Ò¦ê³s°_¨ÓªºÀx¦s®æ,ÂX®i¨ì¤è¥¿°Ï°ìªº³Ì¤p½d³òÀx¦s®æ
c = [¥X³f¸ê®Æ!A1].End(xlToRight).Column
'¡ô¥OC¬O¦¹ªíªºÄæ¼Æ
R = [¥X³f¸ê®Æ!A1].End(xlDown).Row
'¡ô¥OR¬O¦¹ªíªº¦C¼Æ
For i = 2 To R
'¡ô³]°j°é±N«È¤á¦W§Q¥Î¦r¨å¥h°£­«½Æ¨Ã²Ö¥[ GÄ檺ª÷ÃB
   If Yrr(i, 9) < Dats Or Yrr(i, 9) > Datn Then
   '¡ô¦pªG IÄæ¤é´Á¬O¤p©ó¶}©l¤é ©Î IÄæ¤é´Á¬O¤j©óµ²§ô¤é?
      GoTo 999
      '¡ô±ø¥ó¦¨¥ß!´N¸õ¨ì 999ªº¦ì¸mÄ~Äò°õ¦æ!
   End If
   If Yrr(i, 1) <> "" Then
      d = Yrr(i, 1)
      xD(d) = xD(d) + Yrr(i, 7)
   End If
   
999
Next
Arr = Application.Transpose(xD.KEYS)
'¡ô¥OArr ¬O¦r¨åkeyÂà¸m¤§«áªº¤Gºû°}¦C
Brr = Application.Transpose(xD.Items)
'¡ô¥OBrr ¬O¦r¨åItemÂà¸m¤§«áªº¤Gºû°}¦C
Workbooks.Add
'¡ô¶}±Ò¤@­Ó·sÀÉ®×
[A1] = "«È¤á"
[B1] = "¥X³fª÷ÃB²Î­p(NT)/²Î­p°Ï¶¡(" & Dats & "~" & Datn & ")"
'¡ô¹Ïªí¼ÐÃD¥[¤J¾ã²z¤é´Á°Ï¶¡
[A2].Resize(UBound(Arr), 1) = Arr
'¡ô±N Arr°}¦C±q[A2]¶K¤J­È
[B2].Resize(UBound(Brr), 1) = Brr
'¡ô±N Brr°}¦C±q[B2]¶K¤J­È
[A1].CurrentRegion.Sort _
KEY1:=[B1], Order1:=xlDescending, Header:=xlYes
'¡ô¸ê®Æ¦³©ïÀY¦Cªºº¥´î±Æ§Ç
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("¹Ïªí 1")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
End With
[A1].Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlPieExploded
ActiveChart.SetSourceData Source:=Range([A1], Cells([A65536].End(xlUp).Row, "B"))
With ActiveSheet.Shapes("¹Ïªí 2")
   .ScaleWidth 1.5, msoFalse, msoScaleFromBottomRight
   .ScaleWidth 1, msoFalse, msoScaleFromTopLeft
   .ScaleHeight 1.5, msoFalse, msoScaleFromTopLeft
   .IncrementLeft -500
   .IncrementTop -500
   .IncrementTop 400
End With
ActiveSheet.ChartObjects("¹Ïªí 2").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.ShowPercentage = True
Selection.Position = xlLabelPositionOutsideEnd
'¡ô¿ý»s¥¨¶°´N¥i¥H²£¥Í³o¨â­Ó¹Ïªí!µø»Ý¨D½Õ¾ã!
[A1].Activate
Workbooks(AC_WO_NA).Close False
Set xD = Nothing
Set Arr = Nothing
Set Brr = Nothing
End Sub

TOP

¤µ¤Ñ½m²ß¦r¨å,§â3ºØ¤ÀÃþ(¼t°Ó.³W®æ.¹Ï¸¹)¦U°µ¼Æ¶qÁ`­p»Pª÷ÃBÁ`­p

test_1_20221027_2.zip (76.52 KB)

¿ï³æ:


¼t°Ó¤ÀÃþ/Á`­p:


³W®æ¤ÀÃþ/Á`­p:


¹Ï¸¹¤ÀÃþ/Á`­p:


¥D­n½m²ß­×§ï:

    Y(T & "/¼Æ¶q") = Y(T & "/¼Æ¶q") + Arr(i, 5)
    Y(T & "/ª÷ÃB") = Y(T & "/ª÷ÃB") + Arr(i, 7)

    Y(T & "|") = Crr  '#1
    '¡ô¥O «È¤á &"|"¦r¦ê ¬°key ,¥OCrr¬°¥¦ªºitem,
   
~~~
         .Cells(Y(.Name) + 1, 1) = "Á`­p"
         .Cells(Y(.Name) + 1, 5) = Y(Replace(Z, "|", "/¼Æ¶q"))
         .Cells(Y(.Name) + 1, 7) = Y(Replace(Z, "|", "/ª÷ÃB"))
         .Rows(Y(.Name) + 1).Font.Bold = True
         .Columns(1).Font.Bold = True

         .Cells.Columns.AutoFit
         '¡ô¥O¾ãªíªº©Ò¦³Äæ¦ì¦Û°Ê½Õ¾ãÄæ¼e
         .Cells(Y(.Name) + 2, 1) = "¥H¤W¥H ¼t°Ó ¤ÀÃþ·J¾ã¤é´Á°Ï¶¡¬°: " & Dats & "~" & Datn
         '¡ô¸ê®Æ³Ì«á¤U¤@¦CAÄæ¥[¤J¾ã²z¤é´Á°Ï¶¡
         .Cells(Y(.Name) + 2, 1).Font.ColorIndex = 5
         '¡ô¸ê®Æ³Ì«á¤U¤@¦CAÄæ¦r¦âÅÜÂŦâ
         .Cells(Y(.Name) + 2, 1).Font.Bold = True
         '¡ô¸ê®Æ³Ì«á¤U¤@¦CAÄæ¦rÅܲÊÅé
      End With

TOP

        ÀR«ä¦Û¦b : ¤f»¡¤@¥y¦n¸Ü¡A¦p¤f¥X½¬ªá¡F¤f»¡¤@¥yÃa¸Ü¦p¤f¦R¬r³D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD