1234567
返回列表 上一主題 發帖

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

n7822123
　暱稱: 阿龍

中學生Rank: 2

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

回復 15# qaqa3296


你的"模糊比對" 規則真複雜，6~8碼輪流用?

什麼時候用6碼模糊比對，什麼時候用8碼模糊比對? 有沒有7碼比對?

寫程式講究 "邏輯"，你邏輯給的不清不楚，別人只能瞎子摸象!

如准大所說，你應該把"所有" 規格的格式通通列出來，並用顏色區分，要以哪些字元來"模糊比對"

不然以你的"文字敘述" 邏輯，會沒完沒了 ! 下面這句話，說實話，我就真的看不懂!!!

三個字節"-"四個字節做為條件效果，應該可以得到更理想的資料

舉例來說，下面紅色部分是要模糊比對的部分，紅色部分一樣則視為一樣

我隨便列2種，請你把"所有"格式列出，如下參考

A02-A001-E

99-A001-A

程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

qaqa3296

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

回復n7822123
如jcchiang所說是兩側字串空格

感謝jcchiang補充新的語法

我取得資料時，規格欄被當作備註，打了一堆內容，刪掉那些訊息，則出現兩側字串空格最為常見，原本想說是不是要先用VLOOKUP去更新規格的內容，讓資料不會因人工打得錯誤多了空白等等..

看來也要更新一下思考模式了


回復准提部林
我一開始沒有注意到還有其他規格，如准提部林猜測的一樣

剛剛用LEN函數檢查一下

三個字節"-"四個字節做為條件效果，應該可以得到更理想的資料 ，再來才是取8碼，8碼以下的將會列出大量多餘資料，所以不需再建立新的規則，就改程式6~8碼輪流用即可

感謝各位大大的幫忙，有學到新的事物，覺得開心

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2025-6-21 
14#
發表於 2020-8-21 18:09 | 只看該作者
本帖最後由 軒云熊 於 2020-8-21 18:16 編輯

回復 9# qaqa3296
我的寫法比較簡單 但是會比較慢 你看看是不是你要的  如果是文字 你就打文字 列如 煞車 用第二個 如果是 原本的 空格 你就用第一個

javascript:;

列出更多資料.rar (20.27 KB)

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
13#
發表於 2020-8-21 10:06 | 只看該作者
回復 9# qaqa3296


不了解少資料是何意???
根據描述, 將規格 231-215-??? 第三字節去除, 做為另一比對條件,
文字前後若含有空白字元, 套一個TRIM(ARR(i,3)) 即可~~
100-1001.3.V1 這個是否還要取出 100-1001 做為條件,
多列出幾個不同型式的規格文字, 及其截取規則~~~

或者, 規格的前8碼為固定共用, 之後的為變化形, 都視為相同???

TOP

ikboy

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

2016猴年全勤獎章
12#
發表於 2020-8-21 10:02 | 只看該作者
回復 9# qaqa3296
  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 = "[-\.\s]+"
  7.     .Global = True
  8.     For i = 1 To UBound(a)
  9.         If Len(a(i, 3)) = 0 Then a(i, 3) = Trim(a(i, 1))
  10.         a(i, 3) = Trim(a(i, 3))
  11.         k = Split(.Replace(a(i, 3), "|"), "|")
  12.         If UBound(k) > 0 Then k = k(0) & "-" & k(1) Else k = a(i, 3)
  13.         d(k) = ""
  14.     Next
  15.     k = Join(d.keys, "|")
  16.     .Pattern = k
  17.     a = Sheets(2).[a1].CurrentRegion
  18.     b = a: n = 1
  19.     For i = 2 To UBound(a)
  20.         If Len(a(i, 3)) > 0 Then k = a(i, 3) Else k = a(i, 1)
  21.         If .TEST(k) Then
  22.              n = n + 1
  23.              For j = 1 To UBound(a, 2)
  24.                 b(n, j) = a(i, j)
  25.              Next
  26.         End If
  27.     Next
  28.     Workbooks.Add 1
  29.     [a1].Resize(n, 4) = b
  30. End With
  31. End Sub
複製代碼

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
11#
發表於 2020-8-21 07:56 | 只看該作者
本帖最後由 jcchiang 於 2020-8-21 07:59 編輯

回復 9# qaqa3296

如果是字串左右的空格,可使用Trim去除
Trim：刪除字串左、右兩端空白
Set Rg = .Find(Left(Trim(a.Offset(, 2)), 8) & "*", , , xlWhole)

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

qaqa3296

帖子
45 
主題
7 
精華
0 
積分
102 
點名
0  
作業系統
WIN7 
軟體版本
OFFICE 2016 
閱讀權限
20 
註冊時間
2019-4-27 
最後登錄
2026-4-16 
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

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
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

ikboy

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

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

        靜思自在 : 犯錯出懺悔心，才能清淨無煩惱。
1234567
返回列表 上一主題