1234
返回列表 上一主題 發帖

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

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
14# 跳轉到 »
發表於 2021-1-22 23:00 | 只看該作者
回復 13# 軒云熊

請問我查了CurrentRegion是當前區域的意思,
那Arr = [說明!I2].CurrentRegion
是指從I2到哪個儲存格為止?

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
13#
發表於 2021-1-22 00:11 | 只看該作者
回復 12# PJChen

Sub 預約更新_2()
Application.ScreenUpdating = False '關閉更新畫面

    '把工作表的所有內容放到陣列
    Arr = [說明!I2].CurrentRegion
    Brr = [預約!A1].CurrentRegion

    For X = 2 To UBound(Arr) '在陣列裡的第2列開始到最後一列
        A = Arr(X, 1) & "-" & Arr(X, 4) '說明文字 帳號串聯日期
        For Y = X To UBound(Brr) '在陣列裡的第2列開始到最後一列
            B = Brr(Y, 2) & "-" & Brr(Y, 1) '預約文字 帳號串聯日期
            If A = B And Brr(Y, 3) = "" Then K = 0 '如果說明文字與預約文字相同 且預約X列位的第3欄位沒有內容 K就等於0 表示沒有被比對過
            If A = B And Arr(X, 4) <> "" And K <> 1 Then '如果說明文字的與預約文字相同 且說明X列位的第4欄位有內容 且K不等於1 表示沒有被比對過
                K = 1 '表示已經被比對過
                Cells(Y, 3) = Arr(X, 7) '把說明的預約板數放到預約工作表的單項取板欄位
                Cells(Y, 7) = "#0000" & Arr(X, 5) '把說明的 "#0000"串聯取板編號 放到預約工作表的取板編號欄位
            Exit For '跳到下一個迴圈
            End If
        Next Y
    Next X
    'D:F欄的公式值化 是因為  Brr = [預約!A1].CurrentRegion 的關係 所有內容放到陣列 或改成特定位置
'[預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr 因為沒有在陣列裡比對所以不需要
Brr指的是預約工作表比對後的內容
其實用字典方法會更好 但小弟還在學習中不太理解...有空還是會來看看大大們怎麼寫.順便學習^^"
Application.ScreenUpdating = True '開啟更新畫面
End Sub

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
12#
發表於 2021-1-21 21:38 | 只看該作者
回復 11# 軒云熊

真感謝！執行沒問題了
請問原來的程式,不需要了嗎? [預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr
2 To UBound(Arr)...UBound(Arr)前面的數字代表什麼?我常看到程式前有不同數字,但不理解用法！
可以的話能否幫忙解說您寫的程式？

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
11#
發表於 2021-1-21 00:29 | 只看該作者
回復 10# PJChen

把陣列改成 CELLS 應該可以 有空再試試看行不行 感謝
  1. Sub 預約更新_2()
  2. Application.ScreenUpdating = False
  3.     Arr = [說明!I2].CurrentRegion
  4.     Brr = [預約!A1].CurrentRegion

  6.     For X = 2 To UBound(Arr)
  7.         A = Arr(X, 1) & "-" & Arr(X, 4)
  8.         For Y = X To UBound(Brr)
  9.             B = Brr(Y, 2) & "-" & Brr(Y, 1)
  10.             If A = B And Brr(Y, 3) = "" Then K = 0
  11.             If A = B And Arr(X, 4) <> "" And K <> 1 Then
  12.                 K = 1
  13.                 Cells(Y, 3) = Arr(X, 7)
  14.                 Cells(Y, 7) = "#0000" & Arr(X, 5)
  15.             Exit For
  16.             End If
  17.         Next Y
  18.     Next X

  20. Application.ScreenUpdating = True
  21. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
10#
發表於 2021-1-20 21:53 | 只看該作者
回復 8# 軒云熊
您好,
程式在實作時,發現了問題:執行程式後,會將D:F欄的公式值化,且不屬於這個區間的也都值化了,
請問要如何修改程式,讓D:F欄不受程式影響,保持原樣(有公式則保留)？
預約取板.rar (24.19 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
9#
發表於 2021-1-17 20:22 | 只看該作者
回復 8# 軒云熊

感謝！
這個程式OK了

TOP

軒云熊

帖子
254 
主題
6 
精華
0 
積分
310 
點名
0  
作業系統
W10 
軟體版本
Excel 2016 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2019-6-16 
最後登錄
2024-9-23 
8#
發表於 2021-1-17 20:06 | 只看該作者
回復 7# PJChen

有空再試試看這樣行不行  感謝
  1. Public Sub 跨工作表比對練習()

  3.     Arr = [說明!I2].CurrentRegion
  4.     Brr = [預約!A1].CurrentRegion

  6.     For X = 2 To UBound(Arr)
  7.         A = Arr(X, 1) & "-" & Arr(X, 4)
  8.         For Y = X To UBound(Brr)
  9.             B = Brr(Y, 2) & "-" & Brr(Y, 1)
  10.             If A = B And Brr(Y, 3) = "" Then K = 0
  11.             If A = B And Arr(X, 4) <> "" And K <> 1 Then
  12.                 K = 1
  13.                 Brr(Y, 3) = Arr(X, 7)
  14.                 Brr(Y, 7) = "#0000" & Arr(X, 5)
  15.             Exit For
  16.             End If
  17.         Next Y
  18.     Next X

  20.     [預約!A1].Resize(UBound(Brr, 1), UBound(Brr, 2)) = Brr

  22. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
7#
發表於 2021-1-17 18:17 | 只看該作者
本帖最後由 PJChen 於 2021-1-17 18:24 編輯

回復 5# 准提部林

試了幾次還是不行,請大大幫忙看下程式！
感謝
預約取板.rar (21.46 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
6#
發表於 2021-1-17 18:03 | 只看該作者
回復 5# 准提部林
大大,

我試了幾次,都無動作,不知發生什麼事...

TOP

准提部林

帖子
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

        靜思自在 : 是非當教育，讚美作警惕。
1234
返回列表 上一主題