標題:
[發問]
不同工作表間，如何設條件，複製資料到指定儲存格
[打印本頁]
作者:
simplehope
時間:
2016-10-14 00:54
標題:
不同工作表間，如何設條件，複製資料到指定儲存格
[attach]25538[/attach]各位大大好，有爬到此篇
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
時間:
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
複製代碼
作者:
simplehope
時間:
2016-10-17 22:22
謝謝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檔案，才不用每次都改程式碼呢?
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
