[發問] 不同工作表間，如何設條件，複製資料到指定儲存格

不同檔案間依條件複製資料.rar (719.88 KB) 各位大大好，有爬到此篇 http://forum.twbts.com/thread-1467-1-1.html，但想要以下功能：
1. 設條件，如附件，
在目的工作表"M"[D7]的下拉式選單，選250,
就複製來源工作表"W"的
"W"的[AU16] 到"M"的[L16], 等於說"W"綠色部份的LOT 1 ="M"的LOT 01-1
"W"的[AU17] 到"M"的[L57], 等於說"W"綠色部份的LOT 2="M"的LOT 02-1
"W"的[AU18] 到"M"的[L98],等於說"W"綠色部份的LOT 3="M"的LOT 03-1
‧‧‧‧‧以此類推。

在目的工作表"M"[D7]的下拉式選單，選500,
就複製來源工作表"W"的
"W"的[AU16] 到"M"的[L16], 等於說"W"綠色部份的LOT 1 ="M"的LOT 01-1
"W"的[AU17] 到"M"的[L18], 等於說"W"綠色部份的LOT 2 ="M"的LOT 01-2

"W"的[AU18] 到"M"的[L57],等於說"W"綠色部份的LOT 3 ="M"的LOT 02-1
"W"的[AU19] 到"M"的[L59],等於說"W"綠色部份的LOT 4 ="M"的LOT 02-2
‧‧‧‧‧以此類推

在目的工作表"M"[D7]的下拉式選單，選1000,
就複製來源工作表"W"的
"W"的[AU16] 到"M"的[L16], 等於說"W"綠色部份的LOT 1 ="M"的LOT 01-1
"W"的[AU17] 到"M"的[L18], 等於說"W"綠色部份的LOT 2 ="M"的LOT 01-2
"W"的[AU18] 到"M"的[L20], 等於說"W"綠色部份的LOT 3 ="M"的LOT 01-3
"W"的[AU19] 到"M"的[L22], 等於說"W"綠色部份的LOT 4 ="M"的LOT 01-4

"W"的[AU20] 到"M"的[L57], 等於說"W"綠色部份的LOT 5 ="M"的LOT 02-1
"W"的[AU21] 到"M"的[L59], 等於說"W"綠色部份的LOT 6 ="M"的LOT 02-2
"W"的[AU22] 到"M"的[L61], 等於說"W"綠色部份的LOT 7="M"的LOT 02-3
"W"的[AU23] 到"M"的[L63], 等於說"W"綠色部份的LOT 8 ="M"的LOT 02-4
‧‧‧‧‧以此類推

因為來源資料太多，不普能否設字典檔，依條件下去跑，
而不是依條件，用ARRAY 一格格去設定複製位置？

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2016-10-17 14:24 | 只看該作者

回復 1# simplehope
試試看
Moisture test result(2) 模組上的程式碼
Range("d7") 有變動時會自動執行

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim A, I As Integer, ii As Integer, Ar As Variant, E As Range, LotNo As Integer
Dim Rng As Range
If Target.Address <> Range("d7").Address Then Exit Sub
Application.EnableEvents = False
Application.ScreenUpdating = False
A = Split(Range("d7").Validation.Formula1, ",")
LotNo = 20 'LotNo有變動時修改這理 '
For I = 0 To UBound(A)
If Val(A(I)) = [D7].Value Then
For ii = 0 To I
If ii = 0 Then
Set Rng = [L16]
Else
Set Rng = Union(Rng, [L16].Offset((LotNo * 2 + 1) * ii - 1)) '41
End If
Next
Range(Rng, Cells(Rows.Count, "L").End(xlUp)) = ""
Exit For
End If
Next
If Not Rng Is Nothing Then
'******** W 檔案已開啟 ***
Ar = Workbooks("檔案名稱.xls").Sheets(1).[AU16].Resize(LotNo).Value
'******** W 檔案未開啟 ****
'With Workbooks.Open("檔案的路路徑&檔案名稱.xls")
' Ar = .Sheets(1).[AU16].Resize(LotNo).Value
' .Close False
'End With
'*************************************
Ar = Application.Transpose(Ar)
For Each E In Rng.Cells
For I = 1 To 20
E.Cells(I * 2 - 1) = Ar(I)
Next
Next
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

simplehope

小學生 Rank: 1

帖子: 15
主題: 2
精華: 0
積分: 23
點名: 0
作業系統: windows 7
軟體版本: Office 2010
閱讀權限: 10
性別: 男
來自: 台中
註冊時間: 2016-9-22
最後登錄: 2021-3-26

論壇贊助勳章

3^#

發表於 2016-10-17 22:22 | 只看該作者

[版主管理留言]

GBKEE(2016/10/18 06:28): 請附上D7= 250, 500,1000 的範例檔

謝謝G大! 好複雜的程式想必花了不少時間構思。
小弟得細細品味....又很多看不懂的出現了....

目前只差複製資料到指定儲存格的位置，跑出的不是我要的位置。
重新說明我需要的複製到位置如下:

如果D7選250的話，要複製W工作簿的:
AU16是lot 1，複製到L欄對應左邊綠色01-1的[L16]
AU17是lot 2，複製到L欄對應左邊綠色02-1的[L57]
AU18是lot 3，複製到L欄對應左邊綠色03-1的[L98] .....依此類推
等於設定M工作表的每個lot為250噸，所以每個lot 丟一個資料。

如果D7選500的話，要複製W工作簿的:
AU16對應的左邊綠色lot 1，複製到L欄對應左邊綠色01-1的[L16]
AU17對應的左邊綠色lot 2，複製到L欄對應左邊綠色01-2的[L17]
等於設定M工作表的每個lot為500頓，所以從W複製兩個約250噸，丟過去到M的lot1。
AU18對應的左邊綠色lot 3，複製到L欄對應左邊綠色01-1的[L57]
AU19對應的左邊綠色lot 4，複製到L欄對應左邊綠色01-2的[L58]
等於設定M工作表的每個lot為500頓，所以從W複製兩個約250噸，丟過去到M的lot2。
....依此類推

抱歉說明得有點亂，不知道這樣能不能做到呢?

還有因為檔案是要給非開發者使用，
而W工作簿的檔案名稱每次都不一樣，
能否設定，選擇開啟W檔案，才不用每次都改程式碼呢?

TOP

[發問] 不同工作表間，如何設條件，複製資料到指定儲存格

[發問] 不同工作表間，如何設條件，複製資料到指定儲存格

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]