Board logo

標題: [發問] 自動帶入 [打印本頁]
作者: ahui    時間: 2011-12-28 21:25     標題: 自動帶入

請問如何將Sheet1中有數量的自動帶入sheet2的表格中呢。
作者: ANGELA    時間: 2011-12-28 23:19

a2=IF(COUNTIF(Sheet1!$D$2:$D$20,"<>")>=ROW(A1),INDEX(Sheet1!A:A,SMALL(IF(Sheet1!$D$2:$D$20<>"",ROW($D$2:$D$20)),ROW(1:1))),"")  陣列公式
作者: Andy2483    時間: 2022-10-26 11:52

回復 1# ahui
謝謝前輩發表此主題與範例
今天練習運用陣列與字典
資料表數量欄不是空格就帶入到結果表並加總金額
[attach]35409[/attach]

資料表:
[attach]35407[/attach]

結果表:
[attach]35408[/attach]
作者: Andy2483    時間: 2022-10-26 13:18

本帖最後由 Andy2483 於 2022-10-26 13:29 編輯

後學學習心得如下!
請各位前輩指正並指導!謝謝
Option Explicit
Sub TEST()
Dim Brr, i&, T(5), TT, V&, Y, Z
Dim A, B
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y為字典
Set A = Sheets(1)
'↑令A是第一個工作表
Set B = Sheets(2)
'↑令A是第二個工作表
Brr = A.[A1].CurrentRegion
'↑令Brr是陣列,倒入表一[A1]連接到的儲存格
',擴展至最小方正區域儲存個的值
For i = 1 To UBound(Brr)
'↑設順迴圈將符合條件的列倒入Y字典裡
   T(1) = Brr(i, 1)
   T(2) = Brr(i, 2)
   T(3) = Brr(i, 3)
   T(4) = Brr(i, 4)
   T(5) = Brr(i, 5)
   TT = T(1) & "|" & T(2)
   If T(4) <> "" Then
      If Y.Exists(TT) Then
      '↑如果判斷Y字典裡有資料?
         MsgBox i & " 列廠牌+規格 有重複!不允許執行"
       '↑因為後學設定的情境 廠牌+規格 不重複,就該有檢查機制
         '否則數量會只抓最後一筆,而合計值卻已累加金額
         GoTo 333
         '↑跳到 333 位置繼續執行!
      End If
      Y(TT) = Array(T(1), T(2), T(3), T(4), T(5))
      If IsNumeric(T(5)) Then
      '↑如果判斷第5欄的資料是數字?
      '因為[E1] 是 "金額"字串,所以要濾掉非數字!
         V = V + T(5)
         '↑金額累加
      End If
   End If
Next
TT = "總計"
'↑令TT是 "總計" 字串
Y(TT) = Array(TT, "", "", "", V)
'↑把 "總計" 當key,一維陣列當item
'↑有一點很重要! Y(TT) = Array(TT, , , , V) 沒有辦法執行!
B.UsedRange.EntireRow.Delete
'↑刪除表二 有使用的列
B.[A1].Resize(Y.Count, 5) = Application.Transpose(Application.Transpose(Y.items))
'↑把Y字典的Item轉置貼入 從表二的[A1] 開始
B.Range(B.Cells(Y.Count, 1), B.Cells(Y.Count, 5)).Interior.ColorIndex = 6
'↑表二的總計那5格底色改為 黃色6

333
Set Y = Nothing
Set Brr = Nothing
End Sub
作者: Andy2483    時間: 2022-10-26 15:03

後學下午練習了陣列+字典+字典中字典
字典中字典很難!從最簡單學起!
心得註解如下!請前輩們指正並指導!

Sub TEST_2()
Dim Brr, i&, T(5), TT, V&, Y, Z, x, C
Dim A, B
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y為字典
Set A = Sheets(1)
'↑令A是第一個工作表
Set B = Sheets(2)
'↑令A是第二個工作表
Brr = A.[A1].CurrentRegion
'↑令Brr是陣列,倒入表一[A1]連接到的儲存格
',擴展至最小方正區域儲存個的值
For i = 1 To UBound(Brr)
'↑設順迴圈將符合條件的列倒入Y字典裡
   If Brr(i, 4) <> "" Then
   '↑如果數量欄不是空格??
      TT = Brr(i, 1) & "|" & Brr(i, 2)
      '↑令TT是 廠牌&"|"&規格的組合字串
      If Y.Exists(TT) Then
      '↑如果判斷Y字典裡有資料?
         MsgBox i & " 列廠牌+規格 有重複!不允許執行"
        '↑因為後學設定的情境 廠牌+規格 不重複,就該有檢查機制
         '否則數量會只抓最後一筆,而合計值卻已累加金額
         GoTo 333
      End If
      x = x + 1
      '↑符合條件!就開始鋪陳 字典的Key是未來的列號!累加1
      Set Y(x) = CreateObject("Scripting.Dictionary")
      '↑令Y(x)這item是字典中的字典
      Y(x)(1) = Brr(i, 1)
      Y(x)(2) = Brr(i, 2)
      Y(x)(3) = Brr(i, 3)
      Y(x)(4) = Brr(i, 4)
      Y(x)(5) = Brr(i, 5)
      '↑陸續讓字典中的字典key是未來的欄號,item是資料表的值
      TT = Y(x)(1) & "|" & Y(x)(2)
      '↑令TT是字典中字典的 第1個item& "|" &第2個item 的組合字串
      Y(TT) = 1
      '↑這是添進去字典給下一輪迴圈判定重複用的
      If IsNumeric(Y(x)(5)) Then
      '↑如果判斷字典中字典的 第5個item 的資料是數字?
         V = V + Y(x)(5)
         '↑金額累加
      End If
   End If
Next
B.UsedRange.EntireRow.Delete
'↑刪除表二 有使用的列
For R = 1 To x
'↑設順迴圈把字典中字典的item依序帶出來放入表二儲存格中
   For C = 1 To 5
      B.Cells(R, C) = Y(R)(C)
   Next
Next
x = x + 1
'↑鋪陳 總計 列的列數
B.Cells(x, 1) = "總計"
'↑"總計"字串放到指定儲存位置
B.Cells(x, 5) = V
'↑金額放到指定儲存位置
B.Range(B.Cells(x, 1), B.Cells(x, 5)).Interior.ColorIndex = 6
'↑表二的總計那5格底色改為 黃色6

333
Set Y = Nothing
Set Brr = Nothing
End Sub
作者: Andy2483    時間: 2022-10-26 15:31

快速將字典key結果表列號! item為指引資料表的列號
心得註解如下!請各位前輩指正並指導! 謝謝
Sub TEST_3()
Dim Brr, i&, T(5), TT, V&, Y, Z, x, C
Dim A, B
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y為字典
Set A = Sheets(1)
'↑令A是第一個工作表
Set B = Sheets(2)
'↑令A是第二個工作表
Brr = A.[A1].CurrentRegion
'↑令Brr是陣列,倒入表一[A1]連接到的儲存格
',擴展至最小方正區域儲存個的值
For i = 1 To UBound(Brr)
'↑設順迴圈將符合條件的列倒入Y字典裡
   If Brr(i, 4) <> "" Then
   '↑如果數量欄不是空格??
      TT = Brr(i, 1) & "|" & Brr(i, 2)
      '↑令TT是 廠牌&"|"&規格的組合字串
      If Y.Exists(TT) Then
      '↑如果判斷Y字典裡有資料?
         MsgBox i & " 列廠牌+規格 有重複!不允許執行"
         '↑因為後學設定的情境 廠牌+規格 不重複,就該有檢查機制
         '否則數量會只抓最後一筆,而合計值卻已累加金額
         GoTo 333
      End If
      x = x + 1
      '↑符合條件!就開始鋪陳 字典的Key是未來的列號!累加1
      Y(x) = i
      '↑讓字典的Key是未來結果表的列號,item是資料表的列號
      Y(TT) = 1
      '↑這是添進去字典給下一輪迴圈判定重複用的
      If IsNumeric(Brr(i, 5)) Then
      '↑如果判斷陣列中的 第5欄 的資料是數字?
         V = V + Brr(i, 5)
         '↑金額累加
      End If
   End If
Next
B.UsedRange.EntireRow.Delete
'↑刪除表二 有使用的列
For R = 1 To x
'↑設順迴圈把Y字典中的item 資料表列號依序帶出儲存格來放入表二儲存格中
   For C = 1 To 5
      B.Cells(R, C) = Brr(Y(R), C)
   Next
Next
x = x + 1
'↑鋪陳 總計 列的列數
B.Cells(x, 1) = "總計"
'↑"總計"字串放到指定儲存位置
B.Cells(x, 5) = V
'↑金額放到指定儲存位置
B.Range(B.Cells(x, 1), B.Cells(x, 5)).Interior.ColorIndex = 6
'↑表二的總計那5格底色改為 黃色6

333
Set Y = Nothing
Set Brr = Nothing
End Sub
作者: Andy2483    時間: 2022-10-26 16:44

複習  Union()
以下是練習心得註解!
請各位前輩指正並指導!謝謝

Option Explicit
Sub TEST_4()
Dim Arr As Range, i&, x, V
Dim A, B
'↑宣告變數
Set A = Sheets(1)
'↑令A是第一個工作表
Set B = Sheets(2)
'↑令A是第二個工作表
Set Arr = A.[A1].Resize(1, 5)
'↑先Arr是標列儲存格
x = 1
'↑開始計數結果表列數
For i = 2 To A.Cells(Rows.Count, 1).End(3).Row
'↑設順迴圈將符合條件的列加入Arr儲存格集裡
   If A.Cells(i, 4) <> "" Then
   '↑如果數量欄不是空格??
      x = x + 1
      Set Arr = Union(Arr, A.Cells(i, 1).Resize(1, 5))
      '↑以標題列累加符合條件的儲存格!沒有濾 廠牌+規格重複的
      V = V + A.Cells(i, 5)
      '↑金額累加
   End If
Next
B.UsedRange.EntireRow.Delete
'↑刪除表二 有使用的列
Arr.Copy B.[A1]
'將Arr儲存格集 複製到結果表
x = x + 1
'↑鋪陳 總計 列的列數
B.Cells(x, 1) = "總計"
'↑"總計"字串放到指定儲存位置
B.Cells(x, 5) = V
'↑金額放到指定儲存位置
B.Range(B.Cells(x, 1), B.Cells(x, 5)).Interior.ColorIndex = 6
'↑表二的總計那5格底色改為 黃色6
End Sub



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)