返回列表 上一主題 發帖

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

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

資料規則如下圖:
test.png
2023-11-23 10:53



情境資料下載:

測試.zip (10.37 KB)

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

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


我目前作法是先尋找欄位中有刪除線先塗上背景黃色(vba函數),再用
  1. =FILTER(B2:B257,B2:B257<>"")
複製代碼
找出非空白對應的值

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

回復 1# 爆肝達人


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

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

執行結果:
20231124_1.jpg
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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復  爆肝達人


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



  謝謝前輩,符合需求,謝謝

TOP

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

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

謝謝

TOP

回復 4# 爆肝達人


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

工作表模組
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
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

回復 5# Andy2483


前輩非常感恩,已解決。

TOP

        靜思自在 : 人的眼睛長在前面,只看到別人的缺點,絲毫看不到自己的缺點。
返回列表 上一主題