[發問] 將指定欄位內有資料的部份,搬移插入到指定列

marklos

(Sheet1)待處理工作表

下載 (95.45 KB)

2012-5-12 12:23

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

下載 (96.68 KB)

2012-5-12 12:24

感謝~~

icestormer

回復 2# act09132


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

register313

回復 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

回復 3# register313


    感謝您的幫忙~~謝謝!

marklos

回復 3# register313

    感謝您上次的幫忙~ 因為需求功能有些許變更  , 還請撥控幫忙一下 ...
(Sheet1)續上次的問題 , 待處理工作表內多了E欄位 "PN2"

下載 (107.3 KB)

2012-6-6 09:55

(Sheet2)處理後
將D欄位以及E欄內 , 有資料的儲存格依照順序插入至C欄的下一列位置, 且該列其他欄位均複製上一列的資料 , 並刪除D欄與E欄~

下載 (134.29 KB)

2012-6-6 09:55

附件
Excel-Q5.rar (6.34 KB)

下載次數: 4

2012-6-6 09:57

register313

回復 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

複製代碼