匯入總表數據bug

samwang

大學生 Rank: 4

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

13^# 跳轉到 »

發表於 2022-5-29 11:41 | 只看該作者

大師，想問個!!
如果以我原本的一長串的方式是可以帶的過去的
但現在卡住的有兩點
1.如同您寫 ...
waitto04 發表於 2022-5-29 11:26

2.B的欄位都會被跳過
>> 看你的程式，個分頁資料-->"經營表格"-->C欄資料--> 總表
看不懂你實際需求是要什麼，謝謝

TOP

samwang

大學生 Rank: 4

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

12^#

發表於 2022-5-29 11:30 | 只看該作者

回復 samwang

有點想哭!
是因為版本不同的關係所以有所差別??
因為真的帶不出來...
waitto04 發表於 2022-5-29 11:11

With sheets(1) 先設停止點，然後按F5執行，再確認字典有無資料，正確應該要有資料，請確認，謝謝

1.JPG (223.23 KB)

TOP

waitto04

小學生 Rank: 1

帖子: 13
主題: 1
精華: 0
積分: 15
點名: 0
作業系統: W10
軟體版本: 2010
閱讀權限: 10
性別: 男
註冊時間: 2022-5-28
最後登錄: 2022-6-1

11^#

發表於 2022-5-29 11:26 | 只看該作者

反而原有的"經管表格"內容也被清空了
>> 對不起，清除總表資料 = ""，前面少了. 請自行加入，我也把程 ...
samwang 發表於 2022-5-29 10:58

大師，想問個!!
如果以我原本的一長串的方式是可以帶的過去的
但現在卡住的有兩點
1.如同您寫的→ If InStr(sh.Name, "專案") Then '工作名稱有專案
我也想僅sheet Name 有"專案" 才能作業!!
2.B的欄位都會被跳過

這兩個以原本寫的方式是需要再加什麼迴圈嗎?
有嘗試把你的語法帶入我的語法內，但是沒辦法順利成功

藥再麻煩大大了!

TOP

waitto04

小學生 Rank: 1

帖子: 13
主題: 1
精華: 0
積分: 15
點名: 0
作業系統: W10
軟體版本: 2010
閱讀權限: 10
性別: 男
註冊時間: 2022-5-28
最後登錄: 2022-6-1

10^#

發表於 2022-5-29 11:11 | 只看該作者

回復 9# samwang

有點想哭!
是因為版本不同的關係所以有所差別??
因為真的帶不出來...

TOP

samwang

大學生 Rank: 4

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

9^#

發表於 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

waitto04

小學生 Rank: 1

帖子: 13
主題: 1
精華: 0
積分: 15
點名: 0
作業系統: W10
軟體版本: 2010
閱讀權限: 10
性別: 男
註冊時間: 2022-5-28
最後登錄: 2022-6-1

8^#

發表於 2022-5-29 10:40 | 只看該作者

回復 7# samwang

感謝你不厭其煩的測試!!
但沒辦法成功引入...反而原有的"經管表格"內容也被清空了!!
有定義作用頁面是在哪個嗎?

擷取1.PNG (78.86 KB)

TOP

samwang

大學生 Rank: 4

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

7^#

發表於 2022-5-29 10:14 | 只看該作者

回復 samwang

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

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

1.JPG (191.27 KB)

簡化版_0529.zip (136.38 KB)

TOP

waitto04

小學生 Rank: 1

帖子: 13
主題: 1
精華: 0
積分: 15
點名: 0
作業系統: W10
軟體版本: 2010
閱讀權限: 10
性別: 男
註冊時間: 2022-5-28
最後登錄: 2022-6-1

6^#

發表於 2022-5-29 09:59 | 只看該作者

回復 5# samwang

這個沒辦法作業...
沒有bug 但是總表沒有生成

TOP

samwang

大學生 Rank: 4

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

5^#

發表於 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

waitto04

小學生 Rank: 1

帖子: 13
主題: 1
精華: 0
積分: 15
點名: 0
作業系統: W10
軟體版本: 2010
閱讀權限: 10
性別: 男
註冊時間: 2022-5-28
最後登錄: 2022-6-1

4^#

發表於 2022-5-29 09:12 | 只看該作者

寫出了另一個可以導入的
結果變成了B欄被跳過了...悲劇...

Sub test()

工作表1.Activate
Set i = 工作表1.Range("C5:C58")
      For j = 2 To 7

         Range("B3

58").ClearContents
Sheets(j).Range("B3

58").Copy Destination:=[b3]


         工作表7.Cells(4, j) = [c3]
         工作表7.Cells(5, j) = [c5]
         工作表7.Cells(6, j) = [c6]
         工作表7.Cells(7, j) = [c7]
         工作表7.Cells(8, j) = [c8]
         工作表7.Cells(9, j) = [c9]
         工作表7.Cells(10, j) = [c10]
         工作表7.Cells(11, j) = [c11]
         工作表7.Cells(12, j) = [c12]
         工作表7.Cells(13, j) = [c13]
         工作表7.Cells(14, j) = [c14]
         工作表7.Cells(15, j) = [c15]
         工作表7.Cells(16, j) = [c16]
         工作表7.Cells(17, j) = [c17]
         工作表7.Cells(18, j) = [c18]
         工作表7.Cells(19, j) = [c19]
         工作表7.Cells(20, j) = [c20]
         工作表7.Cells(21, j) = [c21]
         工作表7.Cells(22, j) = [c22]
         工作表7.Cells(23, j) = [c23]
         工作表7.Cells(24, j) = [c24]
         工作表7.Cells(25, j) = [c25]
         工作表7.Cells(26, j) = [c26]
         工作表7.Cells(27, j) = [c27]
         工作表7.Cells(28, j) = [c28]
         工作表7.Cells(29, j) = [c29]
         工作表7.Cells(30, j) = [c30]
         工作表7.Cells(31, j) = [c31]
         工作表7.Cells(32, j) = [c32]
         工作表7.Cells(33, j) = [c33]
         工作表7.Cells(34, j) = [c34]
         工作表7.Cells(35, j) = [c35]
         工作表7.Cells(36, j) = [c36]
         工作表7.Cells(37, j) = [c37]
         工作表7.Cells(38, j) = [c38]
         工作表7.Cells(39, j) = [c39]
         工作表7.Cells(40, j) = [c40]
         工作表7.Cells(41, j) = [c41]
         工作表7.Cells(42, j) = [c42]
         工作表7.Cells(43, j) = [c43]
         工作表7.Cells(44, j) = [c44]
         工作表7.Cells(45, j) = [c45]
         工作表7.Cells(46, j) = [c46]
         工作表7.Cells(47, j) = [c47]
         工作表7.Cells(48, j) = [c48]
         工作表7.Cells(49, j) = [c49]
         工作表7.Cells(50, j) = [c50]
         工作表7.Cells(51, j) = [c51]
         工作表7.Cells(52, j) = [c52]
         工作表7.Cells(53, j) = [c53]
         工作表7.Cells(54, j) = [c54]
         工作表7.Cells(55, j) = [c55]
         工作表7.Cells(56, j) = [c56]
         工作表7.Cells(57, j) = [c57]
         工作表7.Cells(58, j) = [c58]

Next

工作表7.Activate

'Columns("B:B").Delete

End Sub

TOP

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]