依料號填入資料(頁 1) - Excel程式區

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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117521&ptid=23461]1#[/url] [i]PJChen[/i] [/b]

請測試看看，謝謝
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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117544&ptid=23461]2#[/url] [i]samwang[/i] [/b]

謝謝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)[color=blue][b](2)[/b][/color])  '[color=blue]範圍--向下多取一行空白列, 若比對不到就利用這行填入空白[/color]
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

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117625&ptid=23461]4#[/url] [i]准提部林[/i] [/b]
准大好,
新月工作表H欄"歸位"原本是空白,
但執行後會填入一些數字,不過我找不到數字的由來,
請幫忙看下?
[attach]34359[/attach]

准提部林 發表於 2021-11-8 20:24

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117641&ptid=23461]5#[/url] [i]PJChen[/i] [/b]

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

PJChen 發表於 2021-11-14 13:55

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117643&ptid=23461]6#[/url] [i]准提部林[/i] [/b]

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

准提部林 發表於 2021-11-14 22:15

[b]回復 [url=http://forum.twbts.com/redirect.php?goto=findpost&pid=117691&ptid=23461]7#[/url] [i]PJChen[/i] [/b]

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

頁: [1]

麻辣家族討論版版's Archiver

依料號填入資料