標題: [發問] (優化)請問如何對應欄位(內容為公式)，將值貼上? [打印本頁]

---

作者: edmondsforum    時間: 2022-7-22 00:17     標題: (優化)請問如何對應欄位(內容為公式)，將值貼上?

本帖最後由 edmondsforum 於 2022-7-22 00:21 編輯

各位大大好，
我今天期望的 案件進度工作表 是：
每天只要我寫完各案的 "本週摘要" 下面的內容後，
當我儲存關閉後，他就會運行VBA，
根據我指定的區間日期，對應上該儲存格內容搜尋後，將 "本週摘要" 該欄下列的內容直接 貼上。
以達到能記錄到今年度每週的摘要∼

如下圖所示

[attach]35061[/attach]

簡單來說
就是能夠 每天我關閉檔案後  能自動運行
將G5:G3003 的內容，根據G4的內容，去查找AF4:CM4
如果找到了，就將其內容貼上，
例如 上面圖片就是  G4內容=BI4，因此G5:G3003 的內容 就貼到 BI5:BI3003

我自己也嘗試寫一組 測試看看

1. Sub 新增()
   
2. 
   
3. For j = 32 To Sheets("test").UsedRange.Columns.Count '從第32欄開始到最右邊
   
4.     If Cells(4, j) = Cells(4, 7) Then   'cells(1,1) 代表第1列 第1欄 = A1 = cells(row列,column欄)
   
5.     t = 1
   
6.         For jj = 5 To 3003
   
7.             Cells(jj, j) = Cells(jj, 7)
   
8.         Next jj
   
9.         MsgBox "已記錄今天 工作摘要 "
   
10.         Exit For
    
11.     End If
    
12. Next j
    
13. 
    
14. If t = 0 Then
    
15.     MsgBox "日期可能跑掉，導致無法自動記錄 工作摘要 ，請確認"
    
16. End If
    
17. 
    
18. End Sub

複製代碼

經過上面測試是可以貼上去，但她是一個一個慢慢貼...導致這3003列 等了快10分鐘多
這樣下來我就沒辦法時間 快速關閉儲存執行VBA了 QQ

再請各位大大協助優化

另外我這邊有個小疑問，有辦法設置一個按鈕，就讓他快速跳到 右手邊(AF4:CM4 ) 對應本週的日期(G4)呢?

附上檔案  [attach]35064[/attach]  再拜託大大了

---

作者: samwang    時間: 2022-7-22 09:01

回復 1# edmondsforum

請測試看看，謝謝

Sub test()
Dim Arr, T$, R&, C%, j%, ck%
With Sheets("test")
    R = .[g65536].End(3).Row
    If R < 5 Then MsgBox "無資料": Exit Sub
    C = .UsedRange.Columns.Count
    T = .[G4]
    Arr = .Range(.[AF4], .Cells(4, C))
    For j = 1 To UBound(Arr, 2)
        If Arr(1, j) = T Then C = j + 31: ck = 1: Exit For
    Next
    If ck = 0 Then MsgBox "日期可能跑掉，導致無法自動記錄 工作摘要 ，請確認": Exit Sub
    Arr = .Range(.[g5], .Cells(R, 7))
    .Cells(5, C).Resize(R, 1) = Arr
End With
End Sub

---

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