標題: [發問] 將指定欄位內有資料的部份,搬移插入到指定列 [打印本頁]

---

作者: marklos    時間: 2012-5-12 12:24     標題: 將指定欄位內有資料的部份,搬移插入到指定列

本帖最後由 marklos 於 2012-5-12 12:27 編輯

(Sheet1)待處理工作表
[attach]10915[/attach]

(Sheet2)處理後
將D欄位內 , 有資料的儲存格搬移到下一列C欄的位置,該列位置跨欄置中 , 並刪除D欄~
[attach]10916[/attach]

感謝~~

---

作者: icestormer    時間: 2012-5-12 13:13

回復 2# act09132


   這位仁兄 想要有權限也不是這樣洗版的吧?

---

作者: register313    時間: 2012-5-12 15:08

回復 1# marklos

1. Sub xx()
   
2. For d = [a1].End(xlDown).Row To 2 Step -1
   
3.   If Cells(d, 4) <> "" Then
   
4.      Rows(d + 1).Insert
   
5.      Cells(d, 4).Copy Cells(d + 1, 3)
   
6.      For i = 1 To 10
   
7.        If Cells(d + 1, i) = "" Then Range(Cells(d + 1, i), Cells(d, i)).Merge
   
8.      Next i
   
9.   End If
   
10. Next d
    
11. Columns(4).Delete
    
12. End Sub

複製代碼

---

作者: marklos    時間: 2012-5-19 22:45

回復 3# register313


    感謝您的幫忙~~謝謝!

---

作者: marklos    時間: 2012-6-6 09:58

回復 3# register313

    感謝您上次的幫忙~ 因為需求功能有些許變更  , 還請撥控幫忙一下 ...
(Sheet1)續上次的問題 , 待處理工作表內多了E欄位 "PN2"
[attach]11281[/attach]
(Sheet2)處理後
將D欄位以及E欄內 , 有資料的儲存格依照順序插入至C欄的下一列位置, 且該列其他欄位均複製上一列的資料 , 並刪除D欄與E欄~
[attach]11282[/attach]

附件
[attach]11283[/attach]

---

作者: register313    時間: 2012-6-6 10:50

本帖最後由 register313 於 2012-6-6 13:04 編輯

回復 5# marklos

1. Sub xx()
   
2. Sheets("sheet1").Cells.Copy Sheets("sheet2").[A1]
   
3. Sheets("sheet2").Select
   
4. For d = [A1].End(xlDown).Row To 2 Step -1
   
5.   c = Application.CountA(Cells(d, 4).Resize(1, 2))
   
6.   If Cells(d, 4) <> "" Then
   
7.      Rows(d).Copy
   
8.      Rows(d + 1).Resize(c).Insert Shift:=xlDown
   
9.      Cells(d + 1, 3).Resize(c, 1) = Application.Transpose(Cells(d, 4).Resize(1, 2))
   
10.   End If
    
11. Next d
    
12. Columns("d:e").Delete
    
13. End Sub

複製代碼

1. Sub yy()
   
2. Set d = CreateObject("scripting.dictionary")
   
3. With Sheets("sheet1")
   
4.   For i = 2 To .[A1].End(xlDown).Row
   
5.     Ar = .Range(.Cells(i, "A"), .Cells(i, "K"))
   
6.     d(.Cells(i, 3).Value) = Ar
   
7.     For j = 4 To 5
   
8.       If .Cells(i, j) <> "" Then
   
9.         Ar(1, 3) = .Cells(i, j)
   
10.         d(.Cells(i, j).Value) = Ar
    
11.       End If
    
12.     Next j
    
13.   Next i
    
14. End With
    
15. With Sheets("sheet2")
    
16.   .Cells = ""
    
17.   Sheets("sheet1").Rows(1).Copy .[A1]
    
18.   .[A2].Resize(d.Count, 11) = Application.Transpose(Application.Transpose(d.items))
    
19.   .Columns("D:E").Delete
    
20.   .[A1].CurrentRegion.Borders.LineStyle = xlContinuous
    
21. End With
    
22. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)