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

¥ÎVBA°µ¬d¸ß¨t²Î

¥ÎVBA°µ¬d¸ß¨t²Î

½Ð±Ð¦U¦ì«e½ú

§Ú¦³¤@­ÓÀx¦ìªí³æ,¤»­Ó¿ûªO¤u§@ªí¸ê®Æ
·Q­n¦b«Ø¥ß¥D­¶°µ¬d¸ß¨t²Î:¬d¿ûªO¸ê®Æ,©ñ¸mÀx¦ì,ÁÙ¦³­þ¨ÇªÅÀx¦ì ,©|¥¼«Ø¥ßÀx¦ìªº¿ûªO
Àx¦ì¬d¸ß¨t²Î.rar (246.13 KB)
¿ûªO¸ê®Æ±`±`·|·s¼W¤Î§R°£¶µ¥Ø
Àx¦ì¤]±`±`·|ÅÜ´«©ñ¸mªº¿ûªO

¦^´_ 1# aassddff736
§ó¥¿¦³7­Ó¿ûªO¤u§@ªí

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-3-4 10:18 ½s¿è

¦^´_ 2# aassddff736

ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«Øij§R°£½d¨ÒÀɸ̪º¦h¾lªÅÄæªÅ¦C,¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub §R°£¦h¾lªÅÄæªÅ¦C()
Dim s As Worksheet, i&, j%, R&, C%
'¡ô«Å§iÅܼÆ:&¬Oªø¾ã¼Æ,%¬Oµu¾ã¼Æ
For Each s In Worksheets
'¡ô³]³v¶µ°j°é!¥OSÅܼƬO¬¡­¶Ã¯¸Ìªº¤u§@ªí
   Application.Goto s.[A1]: R = 0: C = 0
   '¡ô¥O´å¼Ð¸õ¨ì°j°é¤u§@ªíªºA1Àx¦s®æ,¥ORÅܼÆÂk¹s,¥OCÅܼÆÂk¹s
   With Range(s.[A1], s.UsedRange)
   '¡ô¥H¤U¬OÃö©óA1Àx¦s®æ¨ì¦³¨Ï¥ÎÀx¦s®æ³o½d³òÀx¦s®æªºµ{§Ç
      For j = 1 To .Cells.Columns.Count
      '¡ô³]¶¶°j°é!¥Oj±q1 ¨ì¸Ó½d³òªºÄæ¼Æ
         If R < Cells(Rows.Count, j).End(xlUp).Row Then R = Cells(Rows.Count, j).End(xlUp).Row
         '¡ô¦pªGRÅܼƤp©ó°j°éÄæ³Ì«á¦³¤º®eÀx¦s®æªº¦C¸¹,´N¥ORÅܼƬO¸Ó¦C¸¹¼Æ
      Next
      If .Rows.Count > R + 1 Then Rows(R + 1 & ":" & .Rows.Count).Delete
      '¡ô¦pªG½d³ò¦C¼Æ¤j©ó RÅܼÆ+1!´N¥O¦h¾lªº¦C§R°£
      For i = 1 To .Cells.Rows.Count
      '¡ô³]¶¶°j°é!¥Oi±q1 ¨ì¸Ó½d³òªº¦C¼Æ
         If C < Cells(i, Columns.Count).End(xlToLeft).Column Then C = Cells(i, Columns.Count).End(xlToLeft).Column
         '¡ô¦pªGCÅܼƤp©ó°j°é¦C³Ì«á¦³¤º®eÀx¦s®æªºÄ渹,´N¥OCÅܼƬO¸ÓÄ渹¼Æ
      Next
      If .Columns.Count > C + 1 Then Range(Cells(1, C + 1), Cells(1, .Columns.Count)).EntireColumn.Delete
      '¡ô¦pªG½d³òÄæ¼Æ¤j©ó CÅܼÆ+1!´N¥O¦h¾lªºÄæ§R°£
   End With
Next
End Sub

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

TOP

¦^´_ 3# Andy2483


ÁÂÁ±z¡A«D±`·PÁÂ

TOP

¦^´_ 3# Andy2483

    §Ú¥t¦s¦n¤F
Àx¦ì¬d¸ß¨t²Î2.rar (176.68 KB)

TOP

¦^´_ 5# aassddff736

¿ûªO½s¸¹¦³­«½Æ,»Ý¤â°Ê±Æ°£­«½Æ«á¤~Åã¥Ü·J¾ã¸ê®Æ:


Option Explicit
Sub ¸ê®Æ·J¾ã¤J¥D­¶¿z¿ï°Ï()
Dim Brr, Crr, Z, Q, i&, j%, R&, N&, S, T$, E&, TT$
Set Z = CreateObject("Scripting.Dictionary")
With Sheets("¥D­¶")
   .Activate
   If .AutoFilter Is Nothing Then [B17:P17].AutoFilter Else If .FilterMode = True Then .ShowAllData
   With ActiveWindow
      .FreezePanes = False
      .ScrollRow = 13
      .SplitRow = 5
      .FreezePanes = True
   End With
   .UsedRange.Offset(17).EntireRow.Delete
   .[B:D].NumberFormat = "@"
   .[B:D].Font.Bold = True
End With
ReDim Crr(1 To 10000, 1 To 15)
Q = Array(Range([Àx¦ì!B3], [Àx¦ì!A65536].End(xlUp)), Range([Àx¦ì!E3], [Àx¦ì!D65536].End(xlUp)))
For Each Brr In Q
   Brr = Brr
   For i = 1 To UBound(Brr)
      N = N + 1: T = Brr(i, 2): Crr(N, 1) = Brr(i, 1): Crr(N, 2) = T: Z(T) = N
   Next
Next
E = N: Q = Array("1¦Ü588", "SUPER", "POWER", "POWER¸Õ²£", "TEST", "«Ý³ø¼o", "³ø¼o")
For Each S In Q
   Brr = Sheets(S).[A1].CurrentRegion
   For i = 3 To UBound(Brr)
      R = Z(Brr(i, 1))
      If Z.Exists(Brr(i, 2) & "|") Then TT = TT & " / " & S & "ªí_" & Brr(i, 2) Else Z(Brr(i, 2) & "|") = "A"
      If R = 0 Then N = N + 1: R = N
      For j = 1 To 14: Crr(R, j + 1) = Brr(i, j): Next
      If R > E Then Crr(R, 1) = S
   Next
Next
If N = 0 Then Exit Sub
If TT <> "" Then MsgBox "¿ûªO½s¸¹ " & Mid(TT, 4) & " ­«½Æ": Exit Sub
With [B18].Resize(N, 15): .Value = Crr: .Borders.LineStyle = 1: End With
End Sub

Sub ²M°£¥D­¶¿z¿ï°Ï¸ê®Æ()
With Sheets("¥D­¶")
   .Activate
   If .AutoFilter Is Nothing Then [B17:P17].AutoFilter Else If .FilterMode = True Then .ShowAllData
   With ActiveWindow: .FreezePanes = False: .ScrollRow = 1: .SplitRow = 17: .FreezePanes = True: End With
   .UsedRange.Offset(17).EntireRow.Delete
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 6# Andy2483


À³¬°¿ûªO·´·l©Ò¥H¶}·sªº·|¦³­«½Æ¿ûªO¸¹±¡ªp,¥i¥H¨Ì«e­±¬¡­¶¬°Àu¥ý¶Ü?°ò¥»³ø¼o°Ï¤£·|½sÀx¦ì¸¹½X,¦ý¬O·|¬d¸ê®Æ

TOP

¦^´_  Andy2483


À³¬°¿ûªO·´·l©Ò¥H¶}·sªº·|¦³­«½Æ¿ûªO¸¹±¡ªp,¥i¥H¨Ì«e­±¬¡­¶¬°Àu¥ý¶Ü?°ò¥»³ø¼o°Ï¤£·| ...
aassddff736 µoªí©ó 2024-3-7 13:23

·Ó²z»¡¦P¿ûªO½s¸¹ °]²£½s¸¹­n¬Û¦P,¤U¹Ï©Ò¥Ü²£½s¸¹¤£¦P¦ó¦]?


If TT <> "" Then MsgBox "¿ûªO½s¸¹ " & Mid(TT, 4) & " ­«½Æ" : Exit Sub
§ï¬°
If TT <> "" Then MsgBox "¿ûªO½s¸¹ " & Mid(TT, 4) & " ­«½Æ" ': Exit Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 6# Andy2483

ÁÂÁ±zªºÀ°¦£


BÄæ"¦s©ñ°Ï°ì",¦pªG¿ûªO¨S¦³«Ø¥ßÀx¦ì½s¸¹ §Ú·Q¯d¥Õ,¦ý¬O³ø¼o»P±a³ø¼o¿ûªOÅã¥Ü
µM«á´N¬O§Ú­n«ç»ò¬dªÅÀx¦ì

TOP

¦^´_ 8# Andy2483


·s¶}¤@­Ó¤@¼Ë¿ûªO§÷½s·|¤£¦P³ø±b°ÝÃD

TOP

        ÀR«ä¦Û¦b : °ß¨ä´L­«¦Û¤vªº¤H¡A¤~§ó«i©óÁY¤p¦Û¤v¡C
ªð¦^¦Cªí ¤W¤@¥DÃD