1234567
返回列表 上一主題 發帖

[發問] 列出更多的對應資料

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2024-11-9 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2020-8-18 21:32 | 只看該作者

[發問] 列出更多的對應資料

本帖最後由 qaqa3296 於 2020-8-18 21:42 編輯

要將"目標"的資料依序去尋找"庫存"內的資料(以"規格"進行模糊比對)並在"成果"列出全部對應的資料

現在是用笨方法用函數去寫，等待列出資料後再貼到成果。(人工代價太大了，也非常吃系統資源?電腦太慢了)
庫存內還有同規格不同料號的爛帳，庫存資料約有10000筆

感覺可以用VBA寫，但沒有頭緒，想問各位達人有沒有更合適的方式

目前編碼原則(英文字母)**-(英文字母)***
改版(英文字母)**-(英文字母)***-(英文字母區分版本)


其他沒有符合編碼原則的資料我自己手動找查，希望各位達人幫忙，減少工作時間
附上一個範例，笨方法也在目標內，高手請直接剔除即可。
謝謝

補充說明：不要以品名為基準查詢，重複與多於資料太多沒有參考價值
例如：鋁擠型，這千變萬化

列出更多資料.zip (11.81 KB)

收藏 分享

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
2#
發表於 2020-8-19 03:32 | 只看該作者
本帖最後由 n7822123 於 2020-8-19 03:46 編輯

回復 1# qaqa3296

對於VBA來說，這是 piece of cake

按黃色查詢按鈕即可!

程式如下

Sub 模糊查詢()
Dim Rg As Range, Addr0$, R1&
[K:N].ClearContents
With [庫存!C:C]
    Set Rg = .Find([J2] & "*", , , xlWhole)
    If Not Rg Is Nothing Then Addr0 = Rg.Address
    Do While Not Rg Is Nothing
        R1 = R1 + 1
        Rg.Resize(, 4).Offset(, -2).Copy Cells(R1, "K")
        Set Rg = .FindNext(Rg)
        If Rg.Address = Addr0 Then Exit Do
    Loop
End With
End Sub

檔案如下

列出更多資料.rar (17.99 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

hcm19522

帖子
1387 
主題
4 
精華
0 
積分
1397 
點名
0  
作業系統
WIN 
軟體版本
2007 
閱讀權限
50 
性別
男 
註冊時間
2015-9-11 
最後登錄
2024-11-22 

熱烈參與勳章
3#
發表於 2020-8-19 09:55 | 只看該作者
{=INDEX(庫存!A:A,SMALL(IF(ISNUMBER(FIND($J$2,庫存!$C$2:$C$45)),ROW($2:$45),99),ROW(A1)))&""
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
4#
發表於 2020-8-19 11:20 | 只看該作者
尋找目標只有一個, 用篩選再貼即可

TOP

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2024-11-9 
5#
發表於 2020-8-19 20:01 | 只看該作者
看到各位大大的回復，才發現我說得不夠清楚，真是抱歉


1.如何對規格只取要的關鍵字，想想建個輔助查詢欄"LEFT函數"，還是有辦法剔除第二的"-"後面的資料?(想不出有更好的辦法，內容很雜亂)
2.輔助欄有些是空白如何列出需要的資料?
3.批次將輔助欄全部都查詢庫存，然後列到"成果"。
4.實際狀況是無法用品名去篩選資料的，大約500筆都是相同品名，但很多都是我不需要的資料


希望最後得到結果。

感謝各位大大幫忙

列出更多資料V2.zip (17.94 KB)

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
6#
發表於 2020-8-20 09:35 | 只看該作者
回復 5# qaqa3296

把龍大的程式修改一下
依需求直接將Left放入程式中
規格空白只好用品號查詢
執行結果與所需相符

    Sub 模糊查詢()
Dim Rg As Range, Addr0$, R1&
[K:N].ClearContents
[K1:N1] = Array("品號", "品名", "規格", "數量")
R1 = 1
With [庫存!A:C]
   For Each a In Sheets("目標").Range([a2], [a2].End(4))
      If a.Offset(, 2) <> "" Then
         Set Rg = .Find(Left(a.Offset(, 2), 8) & "*", , , xlWhole)
      Else
         Set Rg = .Find(a, , , xlWhole)
      End If
      If Not Rg Is Nothing Then Addr0 = Rg.Address
      Do While Not Rg Is Nothing
         R1 = R1 + 1
         If Rg.Column = 3 Then
           Rg.Resize(, 4).Offset(, -2).Copy Cells(R1, "K")
         Else
           Rg.Resize(, 4).Copy Cells(R1, "K")
         End If
         Set Rg = .FindNext(Rg)
         If Rg.Address = Addr0 Then Exit Do
      Loop
   Next
End With
End Sub

TOP

ikboy

帖子
262 
主題
8 
精華
0 
積分
280 
點名
17  
作業系統
xp 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
來自
HK 
註冊時間
2015-8-11 
最後登錄
2024-11-19 

2016猴年全勤獎章
7#
發表於 2020-8-20 12:19 | 只看該作者
刪去公式,使用VBA會更快：
  1. Sub zz()
  2. Dim a, d As Object, b(), n&
  3. a = Sheets(1).Range("a2:d" & Sheets(1).[a1048576].End(3).Row)
  4. Set d = CreateObject("scripting.dictionary")
  5. With CreateObject("vbscript.regexp")
  6.     .Pattern = "-\w$"
  7.     For i = 1 To UBound(a)
  8.         If Len(a(i, 3)) = 0 Then a(i, 3) = a(i, 1)
  9.         k = a(i, 3)
  10.         a(i, 3) = .Replace(k, "")
  11.         d(a(i, 3)) = ""
  12.     Next
  13.     k = Join(d.keys, "|")
  14.     .Pattern = k
  15.     a = Sheets(2).[a1].CurrentRegion
  16.     ReDim b(1 To UBound(a), 1 To UBound(a, 2))
  17.     For i = 2 To UBound(a)
  18.         If Len(a(i, 3)) > 0 Then k = a(i, 3) Else k = a(i, 1)
  19.         If .test(k) Then
  20.              n = n + 1
  21.              For j = 1 To UBound(a, 2)
  22.                 b(n, j) = a(i, j)
  23.              Next
  24.         End If
  25.     Next
  26.     Sheets(3).[a1].CurrentRegion.Offset(1).Clear
  27.     Sheets(3).[a2].Resize(n, 4) = b
  28. End With
  29. End Sub
複製代碼

zz.zip (18.66 KB)

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-22 
8#
發表於 2020-8-20 21:12 | 只看該作者
簡化不了,
Sub TEST()
Dim Arr, xD, i&, j%, N&, T$, V%
Set xD = CreateObject("scripting.dictionary")
Arr = Range([目標!C1], [目標!A65536].End(xlUp))
For i = 2 To UBound(Arr)
    For j = 1 To 3 Step 2
        T = Arr(i, j):  If T <> "" Then xD(T) = 1
        If T Like "*-*-*" Then xD(Left(T, InStrRev(T, "-") - 1)) = 1
    Next j
Next i
Arr = Range([庫存!D1], [庫存!A65536].End(xlUp))
For i = 2 To UBound(Arr)
    For j = 1 To 3 Step 2
        T = Arr(i, j):  V = V + xD(T)
        If T Like "*-*-*" Then V = V + xD(Left(T, InStrRev(T, "-") - 1))
    Next j
    If V = 0 Then GoTo 101
    N = N + 1: V = 0
    For j = 1 To 4: Arr(N, j) = Arr(i, j): Next
101: Next i
[成果!A2:A6000].ClearContents
If N > 0 Then [成果!A2:D2].Resize(N) = Arr
End Sub


============================

TOP

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2024-11-9 
9#
發表於 2020-8-20 23:25 | 只看該作者
本帖最後由 qaqa3296 於 2020-8-20 23:34 編輯

感謝n7822123大大回復

這個問題最大的問題是取資料的方式

jcchiang大大的程式效果真好，除了沒辦法應付格子內有多餘的空白

ikboy大大會缺少資料，想請問你的程式思路是如何運作(沒辦法應付格子內有多餘的空白)
.Pattern = "-\w$"  
k = Join(d.keys, "|")
作用是什麼呢?

准提部林大大也有缺少資料，想請問你的程式思路是如何運作(可以應付格子內有多餘的空白)
看起來是剔除第二的"-"後面的資料，但不太確定，學習中

回復軒云熊，都要列出

如果想在規格內(不是空白)，沒有找到任何資料，則將字體變紅當作提醒該如何修改?

列出更多資料V4.zip (25.57 KB)

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
10#
發表於 2020-8-21 04:10 | 只看該作者
回復 9# qaqa3296


   什麼叫做 "格子內有多餘的空白"，請講明白一點
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

        靜思自在 : 站在半路，比走到目標更辛苦。
1234567
返回列表 上一主題