[發問] 隔列複製資料至另一工作表，依對應欄位貼上

viggostar

各位高手好，附檔是我做的sample檔

detail工作表為資料來源
Order工作表則是訂料單

內含的巨集語法是
將detail工作表中的資料依C欄的人員選出他還沒訂零件的項目
並將各個我需要的資料一一複製到order工作表的對應欄位中

我有想過用 (sheet1).range("a3").value=(sheet3).range(q3).value 之類的寫法, 就不需要select.copy那麼多次
                      ↑只是印象中記得這麼寫, 書不在手邊
但篩選後的資料並不是相鄰的列, 不知道語法該怎麼改寫

我想做的功能 (如"成果"工作表顯示)
1. 如上所說, 將detail工作表中篩選好的資料, 依不同欄位複製到order工作表的對應欄位中
2. 複製第二個人的資料後, 自動貼到最後一列資料的下一列

感謝各位高手幫忙 Sample.rar (9.39 KB)

下載次數: 25

2010-5-24 23:54

Hsieh

回復 1# viggostar

1. Sub Ex()
   
2. Dim Ar(), Ay(6), Rng As Range, CLM$, A As Range, i%, s&
   
3. With Sheet1
   
4. CLM = "CLKMPY"
   
5. Set Rng = .Range(.[C3], .[C65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
   
6. For Each A In Rng
   
7. For i = 1 To 6
   
8.   Ay(i - 1) = .Cells(A.Row, Mid(CLM, i, 1)).Value
   
9. Next
   
10.    ReDim Preserve Ar(s)
    
11.    Ar(s) = Ay
    
12.    s = s + 1
    
13. Next
    
14. End With
    
15. Sheet2.[A65536].End(xlUp).Offset(1, 0).Resize(s, 6) = Application.Transpose(Application.Transpose(Ar))
    
16. End Sub

複製代碼

viggostar

回復 2# Hsieh

感謝板主的回覆
另有些問題再請教一下
1. CLM = "CLKMPY" 這部份，在我實際的檔案中，複製的是V、AA、AD、AO欄
      嘗試將""裡的值改在"VAAADAY"或"V" & ""AA" & "AD" & "AO"，帶出來的值都不對，請問我該如何設定呢？
2. 實際檔案中"order"的a欄有數字，若使用板主您的程式碼，資料會貼在"order"工作表的第19列~
    且第1項中貼上的欄位在order工作表中並不連續，該如何解決呢？
(今天上傳的已是實際使用的檔案)
感謝幫忙！

Hsieh

回復 3# viggostar

1. Sub Ex()
   
2. Dim Ar(), Ay(4), Rng As Range, Ck(), Kr(), A As Range, i%, s&
   
3. With Sheet1
   
4. Ck = Array("V", "AD", "AO", "AA")
   
5. Kr = Array("C", "E", "H", "K")
   
6. Set Rng = .Range(.[C5], .[C65536].End(xlUp)).SpecialCells(xlCellTypeVisible)
   
7. For Each A In Rng
   
8. For i = 0 To 3
   
9.   Ay(i) = "'" & .Cells(A.Row, Ck(i))
   
10. Next
    
11.    ReDim Preserve Ar(s)
    
12.    Ar(s) = Ay
    
13.    s = s + 1
    
14. Next
    
15. End With
    
16. For i = 0 To UBound(Ar)
    
17. Set A = Sheet3.[C65536].End(xlUp).Offset(1, 0)
    
18.    For j = 0 To 3
    
19.    Sheet3.Cells(A.Row, Kr(j)) = Ar(i)(j)
    
20.    Next
    
21. Next
    
22.    
    
23. End Sub

複製代碼

viggostar

回復 4# Hsieh


可以了，感謝板主！

如果麻煩您逐行解說程式碼的意思，是不是會太過份 >"<

我知道有用到定義、迴圈

但 redim preserve 的意思不了解

為什麼可以只有with sheet1來執行

不需要指定sheet的名字是 order 或 detail

第一行的i、s後為什麼要加%、&完全不懂…

真的很不好意思麻煩你

若您有空再麻煩你回答我

感謝您~

Hsieh

回復 5# viggostar


    Preserve 選擇性引數。當改變原有陣列最後一維的大小時，仍然保有原來的資料的關鍵字。
也就是說陣列大小改變後,仍保留原有的元素
例如宣告一陣列Ar()
若用Redim Ar(5)
那不管之前給過Ar(0),Ar(1),...有甚麼值
經ReDim以後這些值就全部被清除了
                                                         
Dim Ar(4)
for i=0 to 3
   Ar(i)=i
next
上面敘述你已經將原陣列Ar(0)~Ar(3)給過值
現在要擴大成5個元素但要保留Ar(0)~Ar(3)的值
ReDim Preserve Ar(5)
Ar(4)=4
你再測試
for i= 0 to UBound(Ar)
    msgbox "Ar(" & i & ")=" & Ar(i)
next

Hsieh

回復 5# viggostar


    為什麼可以只有with sheet1來執行
不需要指定sheet的名字是 order 或 detail
Sheet1是用工作表的CodeName不會因工作表更名而改變
order 或 detail是工作表的Name會因工作表更名而改變
                                                                                             
變數的資料型態
在 Visual Basic 可用符號 (&) 的型態宣告字元來表示一個 Long
在 Visual Basic 可用百分比符號 (%) 的型態宣告字元來表示一個 Integer。
在 Visual Basic 可用 @ 宣告字元來表示 Currency
在 Visual Basic 中可用型態宣告字元 (!) 來表示一個 Single。
在 Visual Basic，符號 (#) 是表示 Double 的型態宣告字元

GBKEE

回復 4# Hsieh
純參考 可以簡化一下程式碼
Sub Ex()
    Dim Ck(), Kr(), i%
    Ck = Array("V", "AD", "AO", "AA")
    Kr = Array("C", "E", "H", "K")
    With Sheet1
        For i = 0 To UBound(Ck)
            With .Range(Ck(i) & 5, .Range(Ck(i) & 65536).End(xlUp)).SpecialCells(xlCellTypeVisible)
                .copy Sheet3.Range(Kr(i) & 65536).End(xlUp).Offset(1, 0)
            End With
        Next
    End With
End Sub

viggostar

非常感謝Hsieh版主的解說，還麻煩您給了那麼多資料
趁假日剛好努力鑽研

感謝！^^
ps. GBKEE版主的我也會試試看, 謝謝喔^^