iT邦幫忙

0

有一個大量資料如下圖
https://ithelp.ithome.com.tw/upload/images/20200730/20129010CMTq5xut8V.png
想要變成 A欄之後的欄位資料 隔1格貼上A欄
https://ithelp.ithome.com.tw/upload/images/20200730/20129010VCaDtN4kbs.png

Sub button1_click()

Dim colNum As Long

colNum = Cells(2, Columns.Count).End(xlToLeft).Column

For i = 2 To colNum
    Range("B2").Select
    Cells(2, i).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("A2").Select
    r = Range("A2").End(xlDown).Row + 1
    Range("A" & r).Select
    ActiveSheet.Paste
Next
   
   Application.CutCopyMode = False
   
   Range("A2").Select
   
End Sub

目前程式無法隔1格貼上
想問一下要怎麼修改
https://ithelp.ithome.com.tw/upload/images/20200730/20129010n9JlcZt37A.png

2 個回答

0
海綿寶寶
iT邦大神 1 級 ‧ 2020-07-30 20:37:35
最佳解答

改一列

r = Range("A2").End(xlDown).Row + 1

改成

r = Range("A65536").End(xlUp).Row + 2

即可

0
ccenjor
iT邦新手 3 級 ‧ 2020-07-31 21:11:19

我跑題一下。
我是用函數寫了一個。
A6空格。
A7輸入公式:
=IF(COUNT($A$6:A6)<COUNT(INDIRECT("R"&1&"C2"&":R20C"&COUNTIF($A$1:A6,"")+1,FALSE)),INDIRECT("R"&ROW()-SUMPRODUCT(MAX(($A$6:A6="")*ROW($A$6:A6)))&"C"&COUNTIF($A$1:A6,"")+1,FALSE),"")
再向下複製到其他儲存格。
https://ithelp.ithome.com.tw/upload/images/20200731/20109881movpKQC8OC.png

我要發表回答

立即登入回答