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

我的資料長的大概像這樣
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
.空兩列再接別的資料

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

aa.zip (335.14 KB)

樓主熱帖

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

2^#

發表於 2016-5-29 07:13 | 只看該作者

本帖最後由 ML089 於 2016-5-29 07:16 編輯

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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

ML089

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

3^#

發表於 2016-5-29 07:39 | 只看該作者

本帖最後由 ML089 於 2016-5-29 07:57 編輯

'自動偵測表格範圍作為處理
'限用於小表格範圍為 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

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

被論文逼瘋的人

小學生 Rank: 1

帖子: 9
主題: 4
精華: 0
積分: 15
點名: 0
作業系統: windows 10
軟體版本: office 2010
閱讀權限: 10
性別: 女
來自: 桃園
註冊時間: 2016-5-4
最後登錄: 2016-6-8

4^#

發表於 2016-5-30 10:13 | 只看該作者

回復 3# ML089

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

TOP