[發問] Excel抓取多筆資料

cowww

最近長官問我在報表上面的排程異動只能看一筆異動嗎?
有沒有辦法連後續的異動都一起帶出來

下載 (45.22 KB)

2023-6-25 13:00

下載 (19.01 KB)

2023-6-25 13:00

我想了很久，完全不知道要怎麼把後續的異動放進去
目前想到的方法就是點選樞紐表後出現的樣式

下載 (8.91 KB)

2023-6-25 13:03

下載 (25.39 KB)

2023-6-25 13:03

論壇的大大們
小弟想請求兩件事情幫忙
(一)如何呈現出點選樞紐表後出現的樣式
(二)關於長官的要求是否有更好的表現方式

晨會報表.zip (175.63 KB)

下載次數: 12

2023-6-25 13:06

Andy2483

回復 1# cowww


    謝謝前輩發表此主題與範例
後學建議
1.以註解方式呈現 後續的異動,如下圖

下載 (319.87 KB)

2023-6-26 08:29

PS:如果長官使用的螢幕夠大也可分割畫面呈現

cowww

回復 2# Andy2483

非常感謝Andy2483大大的解惑
這樣的方法我有想過，但不可能一筆一筆這樣貼上去，太浪費時間了

還是說可以用公式或VBA完成註解的方式??

PS:長官使用NB

Andy2483

回復 3# cowww


    謝謝前輩回復
後學藉此帖練習陣列.字典與註解,學習方案如下,請前輩參考

執行結果:

下載 (244.56 KB)

2023-6-26 15:45

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
Dim Brr, Crr, Z, i&, T$, 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): Set Sh = xB.Sheets("異動表排序")
Brr = Range(Sh.[E1], Sh.[A65536].End(3))
On Error GoTo 0
If xB Is Nothing Then
   Set xB = Workbooks.Open(PH & "\" & FN)
   Brr = Range([異動表排序!E1], [異動表排序!A65536].End(3))
   xB.Close 0
End If
For i = 1 To UBound(Brr)
   T = Brr(i, 2): If T = "" Then GoTo i00
   If Z(T) = "" Then
      Z(T) = Brr(i, 3) & " █ " & Brr(i, 4)
      Else
         Z(T) = Z(T) & vbLf & Brr(i, 3) & " █ " & Brr(i, 4)
   End If
i00: Next
Brr = Range([專案!D1], [專案!D65536].End(3))
[D:D].ClearComments
For i = 1 To UBound(Brr)
   If Brr(i, 1) = "" Or Z(Brr(i, 1) & "") = "" Then GoTo i01
   Cells(i, 4).AddComment
   Cells(i, 4).Comment.Text Text:=Z(Brr(i, 1) & "")
   Cells(i, 4).Comment.Shape.TextFrame.Characters.Font.Size = 16
   Cells(i, 4).Comment.Shape.DrawingObject.AutoSize = True
i01: Next
Set Z = Nothing: Erase Brr: Set xB = Nothing: Set Sh = Nothing
End Sub

cowww

回復 4# Andy2483

大大您真是太強了
我先做出來給主管看看他能不能接受這樣的表示方式

非常感謝Andy2483大大的解惑

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖複習昨天的學習方案,方案學習心得註解如下,請各位前輩指教

Option Explicit
Sub TEST()
Application.ScreenUpdating = False
'↑令螢幕暫不隨著程序做變化
Dim Brr, Z, i&, T$, PH$, FN$, xB As Workbook, Sh As Worksheet
'↑宣告變數($是字串變數,&是長整數,沒有符號的是通用型變數)
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
PH = ThisWorkbook.Path: FN = "異動表排序.xlsm"
'↑令PH變數是 本檔資料夾位址,令FN變數是 指定檔名(資料表)
On Error Resume Next
'↑令程序暫遇到錯誤就繼續執行下個程序,不要停下來排錯
Set xB = Workbooks(FN): Set Sh = xB.Sheets("異動表排序")
'↑令xB變數是 活頁簿("異動表排序.xlsm"),令Sh變數是其工作表
Brr = Range(Sh.[E1], Sh.[A65536].End(3))
'↑令Brr變數是 二維陣列,以A~E欄儲存格值帶入陣列中
On Error GoTo 0
'↑令程序恢復遇到錯誤就停下來排錯
'這段不排錯的程序是為了 "異動表排序.xlsm"被開啟的情境下,
'讓Brr可以裝進陣列值
'如果檔案沒有被開啟的情況,程序就會跳過這些程序,繼續下行
If xB Is Nothing Then
'↑如果xB變數還沒有裝入活頁簿("異動表排序.xlsm")??
   Set xB = Workbooks.Open(PH & "\" & FN)
   '↑令開啟指定路徑下的檔案,並令xB變數是此活頁簿
   Brr = Range([異動表排序!E1], [異動表排序!A65536].End(3))
   '↑令Brr變數是 二維陣列,以A~E欄儲存格值帶入陣列中
   xB.Close 0
   '↑令活頁簿不存檔關閉
End If
For i = 1 To UBound(Brr)
'↑設順迴圈
   T = Brr(i, 2): If T = "" Then GoTo i00
   '↑令T變數是 迴圈列第2欄Brr陣列值,如果T變數是空的!
   '是就跳到標示i00位置繼續執行
   If Z(T) = "" Then
   '↑如果以T變數查Z字典得item值是空字元?
      Z(T) = Brr(i, 3) & " █ " & Brr(i, 4)
      '↑是就令在Z字典裡的T變數key 的item換成新字串
      '新字串:迴圈列第3欄Brr陣列值連接 " █ "再連接 迴圈列第4欄Brr陣列值,
      '成為新字串,放回Z字典裡
      Else
         Z(T) = Z(T) & vbLf & Brr(i, 3) & " █ " & Brr(i, 4)
         '↑否則(T變數key 的item值已經有字串!)
         '令item連接換行再連接 迴圈列第3欄Brr陣列值連接 " █ "再連接
         '迴圈列第4欄Brr陣列值成為新字串,放回Z字典裡
   End If
i00: Next
Brr = Range([專案!D1], [專案!D65536].End(3))
'↑令Brr變數換裝結果表的D欄儲存格值,依然是 二維陣列
'PS:Brr宣告是通用型變數,可以任意=換裝資料 或Set Brr = 物件
[D:D].ClearComments
'↑令D欄的註解清除
For i = 1 To UBound(Brr)
'↑設順迴圈
   If Brr(i, 1) = "" Or Z(Brr(i, 1) & "") = "" Then GoTo i01
   '↑排除空格或字典裡item是空字元的項目,跳到標示i01位置繼續執行
   Cells(i, 4).AddComment
   '↑令i迴圈數列D欄儲存格插入註解
   Cells(i, 4).Comment.Text Text:=Z(Brr(i, 1) & "")
   '↑令i迴圈數列D欄儲存格的註解文字是 迴圈Brr陣列值查Z字典得item值
   Cells(i, 4).Comment.Shape.TextFrame.Characters.Font.Size = 16
   '↑令i迴圈數列D欄儲存格的註解文字大小為 16
   Cells(i, 4).Comment.Shape.DrawingObject.AutoSize = True
   '↑令i迴圈數列D欄儲存格的註解框自動縮放
i01: Next
Set Z = Nothing: Erase Brr: Set xB = Nothing: Set Sh = Nothing
'↑令釋放變數
End Sub

cowww

回復 2# Andy2483

非常感謝Andy2483大大的解惑

長管說他比較喜歡備註那張圖表的方式
希望備註的地方可以改放在機台那個欄位

下載 (18.53 KB)

2023-6-27 08:23

Andy2483

回復 7# cowww


    都註解了! 請自己試改看看囉,一起學習

cowww

回復 6# Andy2483

求救Andy2483大大

下載 (5.76 KB)

2023-6-27 08:39

下載 (45.91 KB)

2023-6-27 08:39

我有將資料夾的路徑改成以下的寫法
不知道是不是因為這樣導致無法執行
PH = "\\shl-group.com\dept\MFMG\對外單位開放資料\會議室模具追蹤資訊\備份": FN = "勿刪急件公式.xlsm"

Andy2483

回復 9# cowww

求救也沒用
遠水救不了
自己的環境自己才能試,多試幾次吧