[發問] 詢問欄位中有刪除線及空白需先篩選後，搭配vlookup取得資料有沒有更好的方法

爆肝達人

資料規則如下圖:

下載 (24.75 KB)

2023-11-23 10:53

情境資料下載:

測試.zip (10.37 KB)

下載次數: 1

2023-11-23 10:53

"情境呈現結果貼上固定欄位資料，只取非空白欄位對應的數值，再用數值找出對應的字串"

篩選點:
1.字有刪除線篩選掉
2.空白格對應的數值不要取


我目前作法是先尋找欄位中有刪除線先塗上背景黃色(vba函數)，再用

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

複製代碼

找出非空白對應的值

這邊的搭配就卡住，不會用vlookup將上兩個結合

Andy2483

回復 1# 爆肝達人


    謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖學習以前前輩們的問答,學到很多知識
https://forum.twbts.com/viewthre ... =Font.Strikethrough

以下學習的方案,請前輩參考
如果數字有重複只取第1筆對應字串

執行結果:

下載 (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

爆肝達人

回復  爆肝達人


    謝謝論壇,謝謝前輩發表此主題與範例
後學藉此帖學習以前前輩們的問答,學到很多知 ...
Andy2483 發表於 2023-11-24 08:10

  謝謝前輩，符合需求，謝謝

爆肝達人

資料更新問題，不使用巨集的情況

貼上新的A1至H1資料，我能讓他自動更新篩選後的資料顯示在欄位上，
我目前想到是按下Button，vba放入在button中，有其它更好的方法嗎?

謝謝

Andy2483

回復 4# 爆肝達人


    謝謝前輩回復
以下是練習觸發呼叫副程式的方案,請前輩參考
測試_20231124.zip (16.32 KB)

下載次數: 2

2023-11-24 15:46

工作表模組
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

爆肝達人

回復 5# Andy2483


前輩非常感恩，已解決。