[發問] 關於相對位置的複製貼上問題 貼上, 相對位置, 複製

被論文逼瘋的人

我的資料長的大概像這樣
code             t0        T        cp        K        prem空一行        code             t0        T        cp        K          prem        空一行再接別的資料
ln0000001        1        1        1        4        0.865                ln0000002        1        1        1        4.25           0.6575       
ln0000162        1        1        2        4        0.0411                ln0000166        1        1        2        4.25           0.0836       
ln0008058        2        1        1        4        0.9496                ln0008059        2        1        1        4.25           0.7296       
ln0008219        2        1        2        4        0.0277                ln0008223        2        1        2        4.25           0.0577       
空兩列
code             t0        T        cp        K        prem                code             t0        T        cp        K           prem       
ln0008058        2        1        1        4        0.9496                ln0008059        2        1        1        4.25   0.7296       
ln0008219        2        1        2        4        0.0277                ln0008223        2        1        2        4.25           0.0577       
ln0016117        3        1        1        4        0.7622                ln0016118        3        1        1        4.25           0.5564       
ln0016278        3        1        2        4        0.0373                ln0016282        3        1        2        4.25           0.0815       
.空兩列再接別的資料

下載 (115.92 KB)

2016-5-29 00:10

我希望能複製標示黃色的資料(當然原始資料本身是沒有標示黃色的)
然後貼上右邊同一列標示藍色的部位上(取代原先的值)
請問不知道能不能寫成vba 程式碼?或其他更快的方式?
aa.zip (335.14 KB)

下載次數: 2

2016-5-29 00:13

ML089

Sub ex()
    Dim xR As Range, x%
    For Each xR In Range("A1:A108") '範圍自行修改
        If xR = "code" Then
            For x = 8 To Range("AUW1").Column Step 7 '最後複製位置自行修改
                xR(2, x).Resize(1, 6) = xR(2, 1).Resize(1, 6).Value 'code字下第2列
                xR(5, x).Resize(1, 6) = xR(5, 1).Resize(1, 6).Value 'code字下第5列
            Next
        End If
    Next
End Sub

ML089

'自動偵測表格範圍作為處理
'限用於小表格範圍為 7*7
Sub ex()
    Dim xR As Range, x%, y%
    For y = 1 To Cells(Rows.Count, 1).End(xlUp).Row Step 7
        If Cells(y, 1) = "code" Then
            Set xR = Cells(y, 1)
            For x = 8 To Cells(1, Columns.Count).End(xlToLeft).Column Step 7
                xR(2, x).Resize(1, 6) = xR(2, 1).Resize(1, 6).Value
                xR(5, x).Resize(1, 6) = xR(5, 1).Resize(1, 6).Value
            Next
        End If
    Next
End Sub

被論文逼瘋的人

回復 3# ML089

謝謝!!
這真的讓我的資料整理更有效率了!!