[發問] 如何由 SHEET1 資料 轉寫 在SHEET2

aoss98

如何由 SHEET1 資料 轉寫 在SHEET2 ，這程式碼如何? 請各位輩賜教，謝謝!!
SHEET1 資料
ART.               COL.        S        M        L        XL        32        34        36        38
123-456        01        0        2        2         0         0         0         1         1
123-456        58        0        2        2         1         0         0         1         1
123-789        02        1        2        1         0         1         1         1         1
轉寫後 SHEET2 資料如下
ART               COL.        SIZE        QTY.
123-456        01        S        0
123-456        01        M        2
123-456        01        L        2
123-456        01        XL        0
123-456        01        32        0
123-456        01        34        0
123-456        01        36        1
123-456        01        38        1
123-456        58        S        0
123-456        58        M        2
123-456        58        L        2
123-456        58        XL        1
123-456        58        32        0
123-456        58        34        0
123-456        58        36        1
123-456        58        38        1
123-789        02        S        1
123-789        02        M        2
123-789        02        L        1
123-789        02        XL        0
123-789        02        32        1
123-789        02        34        1
123-789        02        36        1
123-789        02        38        1

GBKEE

回復 1# aoss98
試試看

1. Sub Ex()
   
2.     Dim R As Integer, Col As Integer, AR() '():動態陣列 , AR(1)--靜態陣列(0 <-> 1)->[下限<->上限]
   
3.     R = 2               '第2列
   
4.     Col = 3             '第3欄
   
5.     ReDim AR(0)                                         '[ReDim  重新設置]動態陣列:設置元素範圍(0<->0)->[下限<->上限]
   
6.     AR(0) = Array("ART", "COL.", "SIZE", "QTY.")        '指定列陣元素的內容
   
7.     With Sheet1
   
8.         Do While .Cells(R, Col) <> ""                   '第2列->往下 遇到空白儲存格則停止迴圈
   
9.             Do While .Cells(R, Col) <> ""               '第3欄->往右 遇到空白儲存格則停止迴圈
   
10.                 ReDim Preserve AR(UBound(AR) + 1)       '動態陣列:設置元素範圍 (0<->上限+1),Preserve:要保留舊有元素關鍵字
    
11.                 AR(UBound(AR)) = Array(.Cells(R, "A").Value, .Cells(R, "B").Value, .Cells(1, Col).Value, .Cells(R, Col).Value)
    
12.                 Col = Col + 1                           '->往右
    
13.             Loop
    
14.             Col = 3
    
15.             R = R + 1                                   '->往下
    
16.         Loop
    
17.     End With
    
18.     With Sheet2
    
19.         .Cells.Clear                                    '儲存格: 清除
    
20.         .[A1].Resize(UBound(AR) + 1, 4).Value = Application.Transpose(Application.Transpose(AR))
    
21.                                                         '取出陣列元素的內容
    
22.     End With
    
23. End Sub

複製代碼

aoss98

回復 2# GBKEE
GBKEE你好，程式ok沒有問題，謝謝你無私賜教!!