標題: [發問] 依料號填入資料 [打印本頁]

---

作者: PJChen    時間: 2021-10-30 23:05     標題: 依料號填入資料

大大好,

新月工作表E:J欄,以料號為依據,要抓取"比"工作表的資料
二個工作表資料都會有增加or減少,資料常要更新
"比"工作表是資料來源,當其資料為空白時,"新月"工作表同料號的欄位=空白

如何寫二個程式,達成如"新月"工作表 E:J欄 已填入資料的結果?
[attach]34323[/attach]

程式I
"新月"工作表E:G
A欄料號= "比"工作表E欄料號時,則代入以下資料
"新月" E欄 = "比" I欄
"新月" F欄 = "比" J欄
"新月" G欄 = "比" P

程式II
"新月"工作表I:J
依A欄料號= "比"工作表E欄料號,則
1)
"比"工作表AK欄=1or3 ...則  "新月" I欄="V"
"比"工作表AK欄=2 ...則  "新月" I欄="O"
2)
"比"工作表AN欄>0 ...則  "新月" J欄="V"

---

作者: samwang    時間: 2021-11-1 10:35

回復 1# PJChen

請測試看看，謝謝
Sub test()
Dim Arr, xD, T$, i&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([比!an1], [比!e63356].End(3))
For i = 4 To UBound(Arr)
    T = Arr(i, 1)
    xD(T) = Array(Arr(i, 5), Arr(i, 6), Arr(i, 12), Arr(i, 16), Arr(i, 33), Arr(i, 36))
Next
With Sheets("新月")
Arr = .Range(.[j1], .[a63356].End(3))
For i = 4 To UBound(Arr)
    T = Arr(i, 1)
    If xD.Exists(T) Then
        Arr(i, 5) = xD(T)(0): Arr(i, 6) = xD(T)(1): Arr(i, 7) = xD(T)(2)
        If xD(T)(4) <> "" Then Arr(i, 9) = IIf(xD(T)(4) Mod 2, "V", "O")
        Arr(i, 10) = IIf(xD(T)(5) > 0, "V", "")
    End If
Next
    .[a1].Resize(UBound(Arr), 10) = Arr
End With
End Sub

---

作者: PJChen    時間: 2021-11-2 20:14

回復 2# samwang

謝謝Sam
測試OK

---

作者: 准提部林    時間: 2021-11-7 11:11

Sub TEST_A1()
Dim Arr, Brr, xD, i&, j%, R&, V
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([比!an1], [比!e63356].End(3)(2))  '範圍--向下多取一行空白列, 若比對不到就利用這行填入空白  
For i = 4 To UBound(Arr) - 1
    xD(Arr(i, 1) & "") = i:  V = Arr(i, 33)
    If V > 0 Then Arr(i, 33) = IIf(V Mod 2, "V", "O")
    Arr(i, 36) = IIf(Arr(i, 36) > 0, "V", "")
Next
Brr = Range([新月!j1], [新月!a63356].End(3))
For i = 4 To UBound(Brr)
    R = xD(Brr(i, 1) & ""): If R = 0 Then R = UBound(Arr)
    For j = 1 To 6
        Brr(i - 3, j) = Arr(R, Array(5, 6, 12, 16, 33, 36)(j - 1))
    Next j
101: Next i
[新月!e4].Resize(UBound(Brr) - 3, 6) = Brr
End Sub

---

作者: PJChen    時間: 2021-11-8 17:10

回復 4# 准提部林
准大好,
新月工作表H欄"歸位"原本是空白,
但執行後會填入一些數字,不過我找不到數字的由來,
請幫忙看下?
    [attach]34359[/attach]

---

作者: 准提部林    時間: 2021-11-8 20:24

回復 5# PJChen

它是抓"T欄"--"地點統計", 若不要, 改下
For j = 1 To 6
     IF j <> 4 then  Brr(i - 3, j) = Arr(R, Array(5, 6, 12, "", 33, 36)(j - 1))
Next j

---

作者: PJChen    時間: 2021-11-14 13:55

回復 6# 准提部林

准大好,
我想在新月!K欄 填入資料
K欄=比!O欄
請問程式要怎麼修改?
[attach]34388[/attach]

---

作者: 准提部林    時間: 2021-11-14 22:15

回復 7# PJChen


Brr = Range([新月!K1], [新月!a63356].End(3))
For i = 4 To UBound(Brr)
    R = xD(Brr(i, 1) & ""): If R = 0 Then R = UBound(Arr)
     For j = 1 To 7
         If j <> 4 Then Brr(i - 3, j) = Arr(R, Array(5, 14, 12, "", 33, 36, 11)(j - 1))
     Next
     Brr(i - 3, 4) = ""
Next i
[新月!e4].Resize(UBound(Brr) - 3, 7) = Brr

---

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