Excel抓取多筆資料 - Excel程式區 - 麻辣家族討論版版

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

31^# 跳轉到 »

發表於 2023-7-9 10:14 | 只看該作者

異動表排序//B欄公式...可參考
=-LOOKUP(,-MID(C1&"|0",LOOKUP(99,FIND({"|","#","#M","#AL"},C1&"|")+{1,1,2,3}),ROW($1:$9)))
沒有符合的顯示0

A欄公式因版本看不到~~

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-27

32^#

發表於 2023-7-9 10:20 | 只看該作者

本帖最後由准提部林於 2023-7-9 10:30 編輯

來源檔判斷是否開啟//
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(PH & "\" & FN): chk = 1
With xB.Sheets("異動表排序")
Brr = Range(.[G1], .[A65536].End(3)(2))
End With
If chk = 1 Then xB.Close 0

解析//檔案若是事先手動開啟, 不關閉// 若是由程式開啟, 則由程式關閉
為何:
1) 檔案如已開啟, 程式就不可以再開一次, 會造成當機
2) 檔案是手動開啟的, 可能有更改內容而未存檔, 若直接關閉它, 資料將不會被儲存

TOP

cowww

中學生 Rank: 2

帖子: 122
主題: 26
精華: 0
積分: 148
點名: 0
作業系統: windos10
軟體版本: office2016
閱讀權限: 20
註冊時間: 2021-7-8
最後登錄: 2023-8-28

33^#

發表於 2023-7-10 07:56 | 只看該作者

回復 30# qaqa3296

非常感謝qaqa3296大大的解惑

TOP

cowww

中學生 Rank: 2

帖子: 122
主題: 26
精華: 0
積分: 148
點名: 0
作業系統: windos10
軟體版本: office2016
閱讀權限: 20
註冊時間: 2021-7-8
最後登錄: 2023-8-28

34^#

發表於 2023-7-10 07:56 | 只看該作者

回復 31# 准提部林

非常感謝准提部林大大的解惑

TOP

cowww

中學生 Rank: 2

帖子: 122
主題: 26
精華: 0
積分: 148
點名: 0
作業系統: windos10
軟體版本: office2016
閱讀權限: 20
註冊時間: 2021-7-8
最後登錄: 2023-8-28

35^#

發表於 2023-7-10 09:12 | 只看該作者

回復 31# 准提部林

非常感謝准提部林大大的解惑
A欄位的公式
如果B欄位有以下的內容就在前面加入指定的文字
AL#>>前面加入SML-，"M01""M02""M03">>前面加入SML5#
1~15+18+57+21~47+53+49~95+85+58+121~125+164~169+178~179>>前面加入SML3#
96~120>>前面加入PMP#
19+126~128+134~141+183~189>>前面加入SML5#
142~163+181+182>>前面加入SML6#
173~176+180>>前面加入SML7#

=IF(ISNUMBER(SEARCH("AL#",B1)),"SML-"&B1,IF(OR(B1="M01",B1="M02",B1="M03"),"SML5#"&B1,IF(ISNUMBER(B1),
IF(OR(B1=1,B1=2,B1=3,B1=4,B1=5,B1=6,B1=7,B1=8,B1=9,B1=10,B1=11,B1=12,B1=13,B1=14,B1=15,B1=18,B1=57,(B1>=21)*(B1<=47),B1=53,(B1>=49)*(B1<=95),B1=85,B1=58,(B1>=121)*(B1<=125),(B1>=164)*(B1<=169),(B1>=178)*(B1<=179)),
"SML3#"&TEXT(B1,"000"),
IF(AND(B1>=96,B1<=120),
"PMP#"&TEXT(B1,"000"),
IF(OR(B1=19,(B1>=126)*(B1<=128),(B1>=134)*(B1<=141),(B1>=183)*(B1<=189)),
"SML5#"&TEXT(B1,"000"),
IF(OR((B1>=142)*(B1<=163),B1=181,B1=182),
"SML6#"&TEXT(B1,"000"),
IF(OR((B1>=173)*(B1<=176),B1=180),
"SML7#"&TEXT(B1,"000"),
""
)
)
)
)
),
""
)))

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-11-28

36^#

發表於 2023-7-10 10:48 | 只看該作者

本帖最後由 Andy2483 於 2023-7-10 11:16 編輯

回復 32# 准提部林
回復 30# qaqa3296
回復 27# cowww

謝謝前輩再提供新範例
謝謝准提部林前輩指導
謝謝 qaqa3296 一起學習,超認真的學習方案
後學也提供學習方案建議如下,請前輩參考

執行結果:

Option Explicit
Sub 機台排程_Click()
Application.ScreenUpdating = False
Dim Brr, Z, A$, B$, C%, Nm&, chk, Np, i&, R&, T$, T1$, PH$, FN$, xB As Workbook, Sh As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
PH = ThisWorkbook.Path: FN = "異動表排序.xlsm"
On Error Resume Next: Set xB = Workbooks(FN): On Error GoTo 0
If xB Is Nothing Then Set xB = Workbooks.Open(PH & "\" & FN): chk = 1
With xB.Sheets("異動表排序")
   Brr = Range(.[G1], .[A65536].End(3)(2))
End With
If chk = 1 Then xB.Close 0
For i = 2 To UBound(Brr) - 1
If IsError(Brr(i, 1)) Or IsError(Brr(i, 2)) Or Brr(i, 4) = "" Then GoTo i00
   '↑1.2欄有錯誤值或無模具號碼略過
T = Brr(i, 4): T1 = Brr(i, 1): A = Z(T1)
If A = "" Then
   For R = i To UBound(Brr)
      If IsError(Brr(R, 1)) Or IsError(Brr(R, 2)) Or Brr(R, 4) = "" Then GoTo R00
       '↑1.2欄有錯誤值或無模具號碼略過
      If T1 <> Brr(R, 1) Then Exit For
      For C = 4 To 7: B = B & " " & Brr(R, C): Next:
      B = Brr(R, 3) & "    " & B
      If i = R Then A = Brr(R, 1) & vbLf & B Else A = A & vbLf & B
      Z(T1) = A: B = ""
R00:  Next
End If
If Z(T) = "" Then
   Z(T) = Z(T1)
   ElseIf InStr(Z(T), Z(T1)) = 0 Then
      Z(T) = Z(T) & vbLf & vbLf & Z(T1)
End If
i00: Next
Brr = Range([專案!Z1], [專案!D65536].End(3))
[Z:Z].ClearComments: [Z:Z].Interior.ColorIndex = xlNone
For i = 1 To UBound(Brr)
T1 = Brr(i, 1)
If Z(T1) = "" And Z(Brr(i, 23)) <> "" Then
   Cells(i, 26).Interior.ColorIndex = 38
   Np = Np + 1: GoTo i01
End If
If T1 = "" Or Z(T1) = "" Then GoTo i01
If Cells(i, 26) = "" Then
   Nm = Nm + 1
   Cells(i, 26).Interior.ColorIndex = 6
End If
With Cells(i, 26).AddComment
   .Text Text:=Replace(Z(T1), "       " & T1, "_★_" & T1)
   .Shape.TextFrame.Characters.Font.Size = 16
   .Shape.DrawingObject.AutoSize = True
End With
i01: Next
If Nm + Np > 0 Then
MsgBox "有排程無標示機台: " & Nm & " 個" & vbLf & vbLf & _
      "有標示機台無排程: " & Np & " 個"
End If
Set Z = Nothing: Erase Brr: Set xB = Nothing: Set Sh = Nothing
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

cowww