PJChen

　暱稱: PJ

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2021-1-16 16:00 | 只看該作者

[發問] 依指定區間日期、帳號填入資料

大大們好,

1.. 在"說明"工作表中有4個帳號"大、美、佳、振",符合帳號、日期(同帳號及日期,不一定只有一筆)
2.. 以"說明"工作表中的交運日期,最大值&最小值為區間,將M欄的取板編號、O欄的預約板數填入"預約"工作表中的G/C欄
3.. 取板編號填入時,依原號碼,在最前面加上#0000(例:編號為118120,則為#0000118120)
4.. "預約"工作表中,不屬於交運日期區間值的所有資料及帳號,都不要有任何變動(有資料的,保留原資料,無資料則空白)
5.. 例如：1/13~1/29不在此區間,已有的原資料不可變動,1/15 & 1/18也有非屬4大帳號,也不可填入資料

請問要達到這些要求,用函數or程式可以達成?

預約取板.rar (21.1 KB)

樓主熱帖

軒云熊

中學生 Rank: 2

帖子: 254
主題: 6
精華: 0
積分: 310
點名: 0
作業系統: W10
軟體版本: Excel 2016
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2019-6-16
最後登錄: 2024-9-23

2^#

發表於 2021-1-16 22:51 | 只看該作者

回復 1# PJChen
有空幫我試試看是不是這樣比對感謝 ^^"

Public Sub 跨工作表比對練習()
Arr = [說明!I2].CurrentRegion
Brr = [預約!A1].CurrentRegion
For X = 2 To UBound(Arr)
A = Arr(X, 1) & "-" & Arr(X, 4)
For Y = 2 To UBound(Brr)
B = Brr(Y, 2) & "-" & Brr(Y, 1)
If A = B And Arr(X, 4) <> "" Then
Brr(Y, 3) = Arr(X, 7)
Brr(Y, 7) = "#0000" & Arr(X, 5)
End If
Next Y
Next X
[預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr
End Sub

複製代碼

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2836
主題: 10
精華: 0
積分: 2892
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-30

3^#

發表於 2021-1-17 10:19 | 只看該作者

Sub 預約更新()
Dim Arr, xD, i&, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([說明!R1], [說明!i65536].End(xlUp))
For i = 3 To UBound(Arr)
If Arr(i, 1) = "" Or IsDate(Arr(i, 4)) Then
   T = Arr(i, 1) & "|" & Arr(i, 4)
   xD(T) = xD(T) + Val(Arr(i, 7)) '同日同號不只一筆,累加
   xD(T & "/m") = "#0000" & Arr(i, 5) '取板編號
End If
Next i
Arr = Range([預約!G1], [預約!A65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 2) & "|" & Arr(i, 1)
If xD.Exists(T) Then
   Arr(i, 3) = xD(T)
   Arr(i, 7) = xD(T & "/m")
End If
Next i
[預約!A1].Resize(UBound(Arr), 7) = Arr
End Sub

'==========================

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

4^#

發表於 2021-1-17 16:05 | 只看該作者

回復 3# 准提部林
回復 2# 軒云熊

感謝兩位大大,
二個程式測試結果都相同：
同一日期、同帳號有多筆取板資料時,帶出的結果有誤
取板編號只會帶出最後一筆,數量會變成累加

以下圖片為跑程式結果 v.s. 正確資料

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2836
主題: 10
精華: 0
積分: 2892
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-30

5^#

發表於 2021-1-17 17:40 | 只看該作者

回復 4# PJChen

Sub 預約更新()
Dim Arr, xD, i&, T$
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range([說明!R1], [說明!i65536].End(xlUp))
For i = 3 To UBound(Arr)
If Arr(i, 1) <> "" And IsDate(Arr(i, 4)) Then
T = Arr(i, 1) & "|" & Arr(i, 4) & "#0000" & Arr(i, 5)
xD(T) = xD(T) + Val(Arr(i, 7))
End If
Next i
Arr = Range([預約!G1], [預約!A65536].End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 2) & "|" & Arr(i, 1) & Arr(i, 7)
If xD.Exists(T) Then Arr(i, 3) = xD(T)
Next i
[預約!A1].Resize(UBound(Arr), 7) = Arr
End Sub

TOP

PJChen