12
返回列表 上一主題 發帖

[發問] 如何輸入兩個資料自總表中篩出資料，輸入在另一分頁

tsuan

帖子
41 
主題
10 
精華
0 
積分
163 
點名
216  
作業系統
WIN2000 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章2011兔年全勤獎章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2019-1-15 14:28 | 只看該作者

[發問] 如何輸入兩個資料自總表中篩出資料，輸入在另一分頁

請教各位：

我想將附件中的總表資料頁中，依照館別及廠商別抓出資料另存入館別及廠商分頁中，因資料內容欄位會隨每次筆數不同，所以不會是固定筆數，
程度太差期待高人指點。

館別廠商自動選擇.zip (46.11 KB)

收藏 分享

mdr0465

帖子
163 
主題
45 
精華
0 
積分
246 
點名
27  
作業系統
win7 
軟體版本
ie 
閱讀權限
20 
性別
男 
註冊時間
2015-7-8 
最後登錄
2024-9-14 
12#
發表於 2024-3-5 12:37 | 只看該作者
回復 11# Andy2483
Andy 學兄
晚輩十分感謝你耐心的教導,現在明白了當中的運用和技巧,
謝謝你

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
11#
發表於 2024-3-5 07:43 | 只看該作者
回復 10# mdr0465


    謝謝前輩一起學習
請試執行以下代碼:


Option Explicit
Sub Item_test()
Dim xA As Range, N&
With [A2:E4]
   N = .Count: .Select
   MsgBox "此區域儲存格的數量有: " & N & " 個"
   MsgBox "此區域儲存格裡的第1欄第1列儲存格位址是 " & .Item(1, 1).Address(0, 0)
   MsgBox "此區域儲存格裡的第5欄第3列儲存格位址是 " & .Item(3, 5).Address(1, 0)
   MsgBox "此區域儲存格裡的第6欄第3列儲存格位址是 " & .Item(3, 6).Address(0, 1)
   MsgBox "此區域儲存格裡的第1個儲存格位址是 " & .Item(1).Address(1, 1)
   MsgBox "此區域儲存格裡的第5個儲存格位址是 " & .Item(5).Address
   MsgBox "此區域儲存格裡的第6個儲存格位址是 " & .Item(6).Address
   MsgBox "此區域儲存格裡的最後一個儲存格位址是 " & .Item(N).Address
   MsgBox "此區域儲存格上一列第5欄儲存格位址是 " & .Item(0, 5).Address
End With
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

mdr0465

帖子
163 
主題
45 
精華
0 
積分
246 
點名
27  
作業系統
win7 
軟體版本
ie 
閱讀權限
20 
性別
男 
註冊時間
2015-7-8 
最後登錄
2024-9-14 
10#
發表於 2024-3-4 22:23 | 只看該作者
回復 9# Andy2483

Andy 學兄, 後輩有一些編碼上的疑問想向你請教

Sub TEST()
Dim Brr, V, Z, i&, R&, 館$, 廠$
Sheets("館別及廠商").UsedRange.Offset(3).EntireRow.Delete
館 = [館別及廠商!C1]: 廠 = [館別及廠商!E1]: If 館 = "" Or 廠 = "" Then Exit Sub
Brr = Range([總表!L1], [總表!A65536].End(xlUp))
For i = 3 To UBound(Brr)
   If Brr(i, 1) <> 館 Or Brr(i, 12) <> 廠 Then GoTo i01 Else R = R + 1
   Brr(R, 1) = Brr(i, 2): Brr(R, 2) = Brr(i, 3): Brr(R, 3) = Brr(i, 4)
   Brr(R, 4) = Val(Brr(i, 11)): Brr(R, 5) = Val(Brr(i, 10))
   V = V + Brr(R, 4) * Brr(R, 5)
i01: Next
If R = 0 Then Exit Sub
With [館別及廠商!A4].Resize(R, 5)
   .Value = Brr: .Item(0, 5) = "=總表!J2"
   For i = 7 To 10: .Borders(i).Weight = 4: Next
  .Item(.Count + 4) = "合計": .Item(.Count + 5) = V
  .Item(.Count + 5).NumberFormatLocal = "G/通用格式""元"""
End With
End Sub

請問以上紅色的標記 ".item(xxxxx) 是什麼意思呢? 是怎樣用法呢? 我在網上找過,但都還是一頭霧水,所以想請學兄指教,謝謝

TOP

Andy2483
　暱稱: 厚臉皮的學生

大學生Rank: 4

帖子
1446 
主題
40 
精華
0 
積分
1470 
點名
0  
作業系統
Windows 7 
軟體版本
Excel 2010 & 2016 
閱讀權限
50 
性別
男 
來自
台灣 
註冊時間
2020-7-15 
最後登錄
2024-10-21 
9#
發表於 2024-1-12 11:07 | 只看該作者
謝謝論壇(5001),謝謝各位前輩
後學藉此帖練習陣列,學習方案如下,請各位前輩指教
結果表清除舊資料:


資料表:


執行結果:


Option Explicit
Sub TEST()
Dim Brr, V, Z, i&, R&, 館$, 廠$
Sheets("館別及廠商").UsedRange.Offset(3).EntireRow.Delete
館 = [館別及廠商!C1]: 廠 = [館別及廠商!E1]: If 館 = "" Or 廠 = "" Then Exit Sub
Brr = Range([總表!L1], [總表!A65536].End(xlUp))
For i = 3 To UBound(Brr)
   If Brr(i, 1) <> 館 Or Brr(i, 12) <> 廠 Then GoTo i01 Else R = R + 1
   Brr(R, 1) = Brr(i, 2): Brr(R, 2) = Brr(i, 3): Brr(R, 3) = Brr(i, 4)
   Brr(R, 4) = Val(Brr(i, 11)): Brr(R, 5) = Val(Brr(i, 10))
   V = V + Brr(R, 4) * Brr(R, 5)
i01: Next
If R = 0 Then Exit Sub
With [館別及廠商!A4].Resize(R, 5)
   .Value = Brr: .Item(0, 5) = "=總表!J2"
   For i = 7 To 10: .Borders(i).Weight = 4: Next
   .Item(.Count + 4) = "合計": .Item(.Count + 5) = V
   .Item(.Count + 5).NumberFormatLocal = "G/通用格式""元"""
End With
End Sub
用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

tsuan

帖子
41 
主題
10 
精華
0 
積分
163 
點名
216  
作業系統
WIN2000 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章2011兔年全勤獎章
8#
發表於 2019-5-4 08:29 | 只看該作者
感謝 Kubi
已經可以正式使用了，非常感謝

TOP

Kubi

帖子
163 
主題
1 
精華
0 
積分
170 
點名
0  
作業系統
Window 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2010-9-5 
最後登錄
2022-7-20 
7#
發表於 2019-3-25 20:33 | 只看該作者
本帖最後由 Kubi 於 2019-3-25 20:34 編輯
  1. Sub test()
  2.     Dim d As Object
  3.     Dim arr
  4.     Dim brr()
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     With Sheets("總表")
  7.         er = .[A65536].End(3).Row
  8.         arr = .Range("A3:L" & er)
  9.         For c = 5 To 9
  10.            d(.Cells(2, c).Value) = c
  11.         Next c
  12.     End With
  13.     room = Sheets("館別及廠商").[C1].Value
  14.     store = Sheets("館別及廠商").[E1].Value
  15.     n = 0
  16.     For i = 1 To UBound(arr)
  17.         If arr(i, 1) = room And arr(i, 12) = store Then
  18.             n = n + 1
  19.             ReDim Preserve brr(1 To 4, 1 To n)
  20.             For j = 1 To 3
  21.                 brr(j, n) = arr(i, j + 1)
  22.             Next j
  23.             brr(4, n) = arr(i, d(store))
  24.         End If
  25.     Next i
  26.     If n <> 0 Then
  27.         Sheets("館別及廠商").Rows("4:65536").Delete
  28.         Sheets("館別及廠商").[A4].Resize(n, 4) = Application.Transpose(brr)
  29.     Else
  30.         MsgBox "找不到"
  31.     End If
  32.     Set d = Nothing
  33.     Erase brr
  34.     arr = ""
  35. End Sub
複製代碼
回復 6# tsuan

TOP

tsuan

帖子
41 
主題
10 
精華
0 
積分
163 
點名
216  
作業系統
WIN2000 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章2011兔年全勤獎章
6#
發表於 2019-3-22 16:09 | 只看該作者
回復 4# Kubi


請問Kudi大大:

我在總表資料上方插入一列，即出現陣列索引書線錯誤訊息，懇請您再指導一下，謝謝。

館別廠商自動選擇.zip (53.83 KB)

TOP

tsuan

帖子
41 
主題
10 
精華
0 
積分
163 
點名
216  
作業系統
WIN2000 
軟體版本
OFFICE 2003 
閱讀權限
20 
性別
男 
註冊時間
2010-12-28 
最後登錄
2024-11-22 

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章2011兔年全勤獎章
5#
發表於 2019-1-19 17:27 | 只看該作者
感謝 Kubi
正是如我所需要的，非常感激

TOP

Kubi

帖子
163 
主題
1 
精華
0 
積分
170 
點名
0  
作業系統
Window 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
男 
註冊時間
2010-9-5 
最後登錄
2022-7-20 
4#
發表於 2019-1-19 10:03 | 只看該作者
回復 1# tsuan
請參考
  1. Sub test()
  2.     Dim d As Object
  3.     Dim arr
  4.     Dim brr()
  5.     Set d = CreateObject("Scripting.Dictionary")
  6.     With Sheets("總表")
  7.         er = .[A65536].End(3).Row
  8.         arr = .Range("A2:L" & er)
  9.         For c = 5 To 9
  10.             d(.Cells(1, c).Value) = c
  11.         Next c
  12.     End With
  13.     room = Sheets("館別及廠商").[C1].Value
  14.     store = Sheets("館別及廠商").[E1].Value
  15.     n = 0
  16.     For i = 1 To UBound(arr)
  17.         If arr(i, 1) = room And arr(i, 12) = store Then
  18.             n = n + 1
  19.             ReDim Preserve brr(1 To 4, 1 To n)
  20.             For j = 1 To 3
  21.                 brr(j, n) = arr(i, j + 1)
  22.             Next j
  23.             brr(4, n) = arr(i, d(store))
  24.         End If
  25.     Next i
  26.     If n <> 0 Then
  27.         Sheets("館別及廠商").Rows("4:65536").Delete
  28.         Sheets("館別及廠商").[A4].Resize(n, 4) = Application.Transpose(brr)
  29.     Else
  30.         MsgBox "找不到"
  31.     End If
  32.     Set d = Nothing
  33.     Erase brr
  34.     arr = ""
  35. End Sub
複製代碼

TOP

        靜思自在 : 謊言像一朵盛開的鮮花，外表美麗，生命短暫。
12
返回列表 上一主題