匯入總表數據bug

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

1^# 跳轉到 »

發表於 2022-5-29 08:17 | 顯示全部帖子

回復 1# waitto04

方便附上檔案，謝謝

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

2^#

發表於 2022-5-29 09:43 | 顯示全部帖子

回復 3# waitto04

請測試看看，謝謝

Sub test()
Dim Arr, xD, T$, i&, j%
Set xD = CreateObject("Scripting.Dictionary")
For Each sh In Sheets
If InStr(sh.Name, "專案") Then
      With sh
         Arr = .[a1].CurrentRegion
         For i = 5 To UBound(Arr)
            If Arr(i, 3) = "" Then GoTo 90
            T = sh.Name & "|" & Arr(i, 1)
            xD(T) = Arr(i, 3)
90:       Next
      End With
End If
Next
With Sheets(1)
[b5:f58] = ""
Arr = .[a1].CurrentRegion
For i = 5 To UBound(Arr): For j = 2 To UBound(Arr, 2)
      T = Arr(4, j) & "|" & Arr(i, 1)
      Arr(i, j) = xD(T)
Next: Next
.[a1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
End With
End Sub

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

3^#

發表於 2022-5-29 10:14 | 顯示全部帖子

回復 samwang

這個沒辦法作業...
沒有bug 但是總表沒有生成
waitto04 發表於 2022-5-29 09:59

我測試沒問題如附件，比對條件如照片(工作表名稱+項目)有符合就帶入數據，
請再測試看看，謝謝

1.JPG (191.27 KB)

簡化版_0529.zip (136.38 KB)

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2026-5-26

4^#

發表於 2022-5-29 10:58 | 顯示全部帖子

本帖最後由 samwang 於 2022-5-29 11:00 編輯

回復 samwang

感謝你不厭其煩的測試!!
但沒辦法成功引入...反而原有的"經管表格"內容也被清空了 ...
waitto04 發表於 2022-5-29 10:40

反而原有的"經管表格"內容也被清空了
>> 對不起，清除總表資料[b5:f58] = ""，前面少了. 請自行加入，我也把程式附上說明，請再自己確認一下，謝謝

Sub test()
Dim Arr, xD, T$, i&, j%
Set xD = CreateObject("Scripting.Dictionary")
For Each sh In Sheets
If InStr(sh.Name, "專案") Then '工作名稱有專案
      With sh
         Arr = .[a1].CurrentRegion '資料裝入數組
         For i = 5 To UBound(Arr)
            If Arr(i, 3) = "" Then GoTo 90 '沒數據離開
            T = sh.Name & "|" & Arr(i, 1)  '條件:工作表名稱+項目
            xD(T) = Arr(i, 3)             '數據裝入字典
90:       Next
      End With
End If
Next
With Sheets(1)
.[b5:f58] = "" '清除原有數據資料，前面原來漏掉  .   ，請自行修改
Arr = .[a1].CurrentRegion  '資料裝入數組
For i = 5 To UBound(Arr): For j = 2 To UBound(Arr, 2)
      T = Arr(4, j) & "|" & Arr(i, 1) '條件:工作表名稱+項目
      Arr(i, j) = xD(T) '匯出字典數據
Next: Next
.[a1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr '數據回填到excel
End With
End Sub

TOP

samwang