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

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

¦^´_ 20# Andy2483


    ÁÂÁ±z §Úªº¯«

TOP

¦^´_ 20# Andy2483
½Ð°Ý«e½ú
§Ú·Q°µ¤@­Óªí³æ ªí³æ¤º®e¬O©Ò¦³ªÅÀx¦ì ÂI¿ï«á¶ñ¤JAÄæªí®æ
ªí³æ¥ªÃä"¦s©ñ°Ï°ì"¹w³]¥þ¿ï
­n¦p¦ó³]©w?

TOP

¦^´_ 22# aassddff736


¥H¤U¬O ¾Ç²ß¸ê®ÆÅçÃÒ²M³æªº¤èªk,½Ð«e½ú°Ñ¦Ò
Àx¦ìªÅ¦ì¦s©ñ°Ï²M³æ:


Àx¦ìªÅ¦ì²M³æ:


±N¥H¤U¥N½X´Ó¤J ¥D­¶ ¤u§@ªí¼Ò²Õ¤U
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   Dim Ad$, Arr, Z, xR As Range, i&
   Set Arr = Intersect([¥D­¶!B17].CurrentRegion, [¥D­¶!B18:D65536])
   If Me.UsedRange.Rows.Count <= 17 Then Exit Sub
   If .Columns.Count > 1 Then Exit Sub
   Set xR = Intersect(Arr.Resize(, 1), .Cells): Arr.Resize(, 2).Validation.Delete
   If Not xR Is Nothing Then
      If .Count > 1 Then Exit Sub
      If Trim(.Value) = "" Then Exit Sub Else Arr = Arr
      Set Z = CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(Arr)
         If Arr(i, 1) = .Value And Arr(i, 3) = "" Then Z(Arr(i, 2)) = ""
      Next
      With .Item(1, 2).Validation
         If Z.Count > 0 Then .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
         xlBetween, Formula1:=Join(Z.KEYS(), ",")
      End With
      Set Z = Nothing: Arr = Empty: Exit Sub
   End If
   Set xR = Intersect(Arr.Resize(, 2), .Cells)
   If Not xR Is Nothing Then
      If .Count > 1 Then Exit Sub
      If .Value = "" Then Exit Sub Else Arr = Arr
      Set Z = CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(Arr): Z(Arr(i, 1) & "/" & Arr(i, 2)) = i + 17: Next
      If Z.EXISTS(.Item(1, 0) & "/" & .Value) Then Rows(Z(.Item(1, 0) & "/" & .Value)).Delete
      Ad = .Cells(1, 2).Hyperlinks(1).SubAddress
      Application.Goto Sheets(Split(Ad, "!")(0)).Range(Split(Ad, "!")(1))
      Selection(1) = .Value: Set Z = Nothing: Arr = Empty
   End If
End With
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Arr, Z, i&, xR As Range
With Target
   Set Arr = Intersect([¥D­¶!B17].CurrentRegion, [¥D­¶!B18:D65536])
   Set xR = Intersect(Arr.Resize(, 1), .Cells): Arr.Resize(, 1).Validation.Delete: Arr = Arr
   If Not xR Is Nothing Then
      Set Z = CreateObject("Scripting.Dictionary")
      For i = 1 To UBound(Arr)
         If Arr(i, 1) <> "" And Arr(i, 3) = "" Then Z(Arr(i, 1)) = ""
      Next
      With .Validation
         If Z.Count > 0 Then .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
         xlBetween, Formula1:=Join(Z.KEYS(), ","): Set Z = Nothing: Arr = Empty
      End With
   End If
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 23# Andy2483
ÁÂÁ±z
§Ú¸Õ¸Õ

TOP

¦^´_ 23# Andy2483
§Ú¸Õ¤F¸õ¦^"²M°£¥D­¶¿z¿ï°Ï¸ê®Æ"·|³ø¿ù
ªÅÀx¦ì¿z¿ï¸ê®Æ¯àª½±µ®M¦b¬¡­¶¸ê®Æ¤Uµ¹¶Ü ´N¤£¥Î¸õ¨ì¥D­¶
attachimg]37628[/attachimg]

Â^¨ú1.JPG (28.56 KB)

Â^¨ú1.JPG

TOP

¦^´_ 25# aassddff736


«á¾Ç¥H©¹¸ê®Æ³B²z¤è¦¡³£¬O ¥D­¶¬°¥D,¥²­n®É¦A¤ÀÀÉ°µ²Î­p,¤ÀÀɥΧ¹´N²M°£,ÁÂÁ«e½ú
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 26# Andy2483


¤F¸Ñ
«D±`·PÁ±z

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-3-27 14:06 ½s¿è

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ß°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub ¤£­«½Æ¦UÄæ©ú²Ó()
Dim Brr, Crr, Z, Q, i&, j%, R&, T$, x%, Rm&
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect([¥D­¶!B17].CurrentRegion, [¥D­¶!B17:P65536])
ReDim Crr(10000, 1 To UBound(Brr, 2))
For j = 1 To UBound(Brr, 2)
   For i = 2 To UBound(Brr)
      Q = Split(Brr(i, j) & Chr(10), Chr(10))
      For x = 0 To UBound(Q) - 1
         T = Trim(Q(x))
         If Not Z.Exists(T) And T <> "" Then R = R + 1: Crr(R, j) = T: Z(T) = "": Rm = IIf(R > Rm, R, Rm)
      Next
   Next
   Crr(0, j) = Brr(1, j): R = 0: Z.RemoveAll
Next
Workbooks.Add
With [A1].Resize(Rm + 1, UBound(Brr, 2))
   .NumberFormat = "@": .Value = Crr: .EntireColumn.AutoFit
   For j = 1 To UBound(Brr, 2): .Columns(j).Sort KEY1:=.Cells(1, j), Order1:=1, Header:=1: Next
End With
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

¦^´_ 28# Andy2483
¨S¦³©ú¥Õ

TOP

¥»©«³Ì«á¥Ñ Andy2483 ©ó 2024-3-27 14:07 ½s¿è

¦^´_ 29# aassddff736

¯Â½m²ß,½Ð°Ñ¦Ò,¥Øªº¬O¾ã²z¥X¨C­ÓÄæ¦ì¿é¤J¹Lªº¶µ¥Ø(¤£­«½Æ¨Ã¥B°µ±Æ§Ç)
°õ¦æµ²ªG:
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¤@¥y·Å·xªº¸Ü¡A´N¹³©¹§O¤H¨­¤WÅx­»¤ô¡A¦Û¤v·|ªg¨ì¨â¤Tºw¡C
ªð¦^¦Cªí ¤W¤@¥DÃD