[µo°Ý] ¸ß°ÝÄæ¦ì¤¤¦³§R°£½u¤ÎªÅ¥Õ»Ý¥ý¿z¿ï«á¡A·f°tvlookup¨ú±o¸ê®Æ¦³¨S¦³§ó¦nªº¤èªk

Ãz¨x¹F¤H

¸ê®Æ³W«h¦p¤U¹Ï:

¤U¸ü (24.75 KB)

2023-11-23 10:53

±¡¹Ò¸ê®Æ¤U¸ü:

´ú¸Õ.zip (10.37 KB)

¤U¸ü¦¸¼Æ: 1

2023-11-23 10:53

"±¡¹Ò§e²{µ²ªG¶K¤W©T©wÄæ¦ì¸ê®Æ¡A¥u¨ú«DªÅ¥ÕÄæ¦ì¹ïÀ³ªº¼Æ­È¡A¦A¥Î¼Æ­È§ä¥X¹ïÀ³ªº¦r¦ê"

¿z¿ïÂI:
1.¦r¦³§R°£½u¿z¿ï±¼
2.ªÅ¥Õ®æ¹ïÀ³ªº¼Æ­È¤£­n¨ú


§Ú¥Ø«e§@ªk¬O¥ý´M§äÄæ¦ì¤¤¦³§R°£½u¥ý¶î¤W­I´º¶À¦â(vba¨ç¼Æ)¡A¦A¥Î

1. =FILTER(B2:B257,B2:B257<>"")

½Æ»s¥N½X

§ä¥X«DªÅ¥Õ¹ïÀ³ªº­È

³oÃ䪺·f°t´N¥d¦í¡A¤£·|¥Îvlookup±N¤W¨â­Óµ²¦X

Andy2483

¦^´_ 1# Ãz¨x¹F¤H


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«¾Ç²ß¥H«e«e½ú­Ìªº°Ýµª,¾Ç¨ì«Ü¦hª¾ÃÑ
https://forum.twbts.com/viewthre ... =Font.Strikethrough

¥H¤U¾Ç²ßªº¤è®×,½Ð«e½ú°Ñ¦Ò
¦pªG¼Æ¦r¦³­«½Æ¥u¨ú²Ä1µ§¹ïÀ³¦r¦ê

°õ¦æµ²ªG:

¤U¸ü (123.16 KB)

2023-11-24 08:10

Option Explicit
Sub TEST()
Dim A As Range, i%, Z
Set Z = CreateObject("Scripting.Dictionary")
For Each A In Intersect(ActiveSheet.UsedRange, [B:B,D:D,F:F]).SpecialCells(2)
   If A.Item(1, 0) = "" Then GoTo A01
   For i = 1 To Len(A & "")
      If A.Characters(i, 1).Font.Strikethrough = True Then GoTo A01
   Next
   If Z(Val(A.Item(1, 0))) = "" Then Z(Val(A.Item(1, 0))) = A
A01: Next
With [H2].Resize(Z.Count, 2)
   Intersect(ActiveSheet.UsedRange, .EntireColumn).Offset(1).ClearContents
   .Columns(1) = Application.Transpose(Z.Keys)
   .Columns(2) = Application.Transpose(Z.Items)
   .Sort KEY1:=.Item(1), Order1:=1, Header:=2
End With
End Sub

Ãz¨x¹F¤H

¦^´_  Ãz¨x¹F¤H


    ÁÂÁ½׾Â,ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò
«á¾ÇÂǦ¹©«¾Ç²ß¥H«e«e½ú­Ìªº°Ýµª,¾Ç¨ì«Ü¦hª¾ ...
Andy2483 µoªí©ó 2023-11-24 08:10

  ÁÂÁ«e½ú¡A²Å¦X»Ý¨D¡AÁÂÁÂ

Ãz¨x¹F¤H

¸ê®Æ§ó·s°ÝÃD¡A¤£¨Ï¥Î¥¨¶°ªº±¡ªp

¶K¤W·sªºA1¦ÜH1¸ê®Æ¡A§Ú¯àÅý¥L¦Û°Ê§ó·s¿z¿ï«áªº¸ê®ÆÅã¥Ü¦bÄæ¦ì¤W¡A
§Ú¥Ø«e·Q¨ì¬O«ö¤UButton¡Avba©ñ¤J¦bbutton¤¤¡A¦³¨ä¥¦§ó¦nªº¤èªk¶Ü?

ÁÂÁÂ

Andy2483

¦^´_ 4# Ãz¨x¹F¤H


    ÁÂÁ«e½ú¦^´_
¥H¤U¬O½m²ßIJµo©I¥s°Æµ{¦¡ªº¤è®×,½Ð«e½ú°Ñ¦Ò
´ú¸Õ_20231124.zip (16.32 KB)

¤U¸ü¦¸¼Æ: 2

2023-11-24 15:46

¤u§@ªí¼Ò²Õ
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
   If Intersect(.Cells, [A:F]) Is Nothing Then Exit Sub Else Call Ex
End With
End Sub

¤@¯ë¼Ò²Õ:
Option Explicit
Sub Ex()
Dim Arr, A, i%, Z
Set Z = CreateObject("Scripting.Dictionary")
Set Arr = CreateObject("System.Collections.ArrayList")
For Each A In Intersect(ActiveSheet.UsedRange, [B:B,D:D,F:F]).SpecialCells(2)
   If A.Item(1, 0) = "" Then GoTo A01
   For i = 1 To Len(A & "")
      If A.Characters(i, 1).Font.Strikethrough = True Then GoTo A01
   Next
   If Z(Val(A.Item(1, 0))) = "" Then Z(Val(A.Item(1, 0))) = A
A01: Next
For Each A In Z.Keys
   If A <> vbNullString And Not Arr.contains(A) Then Arr.Add (A)
Next
Arr.Sort: Arr = Arr.toarray
ReDim A(UBound(Arr), 1 To 2)
For i = 0 To UBound(Arr): A(i, 1) = Arr(i): A(i, 2) = Z(Arr(i)): Next
With [H2].Resize(Z.Count, 2)
   Intersect(ActiveSheet.UsedRange, .EntireColumn).Offset(1).ClearContents
   .Value = A
End With
End Sub

Ãz¨x¹F¤H

¦^´_ 5# Andy2483


«e½ú«D±`·P®¦¡A¤w¸Ñ¨M¡C