各位大哥好請問一個表單轉換巨集問題

lionliu

各位大哥好:
我友有個表單轉換的巨集問題，不知錯在哪裡。
附上我的巨集檔，我想讓sheet(1)轉換sheet(3)。
活頁簿2.rar (11.64 KB)

下載次數: 6

2015-9-19 11:50

GBKEE

回復 1# lionliu

1. L = 1
   
2.         Do Until Sheets(1).Cells(i, "d") = "" And Sheets(1).Cells(i, "b") <> Empty
   
3.             '設定的判斷式為True時"   離開  Do Loop 迴圈
   
4.             '變數 i 在迴圈中一直沒變動的,所以進入迴圈後跑不完了.
   
5.             Sheets(2).Cells(k, "b").Offset(L - 1) = Sheets(1).Cells(k, "b").Offset(L)
   
6.             L = L + 1  '
   
7.         Loop

複製代碼

用刪除

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, i As Integer
   
4.     With Sheets("PKG").UsedRange.Columns("a:g").Rows '這範圍的Rows(列的物件集合)
   
5.         For i = 2 To .Count                          '由第2列開始
   
6.             If Application.CountA(.Rows(i)) = .Columns.Count Then   '列中的儲存格都有資料            '
   
7.                 .Rows(i).Cells(1, 2) = .Rows(i + 1).Cells(1, 2)     '
   
8.                 If Rng Is Nothing Then                              '範圍指定到變數中
   
9.                     Set Rng = .Rows(i + 1)
   
10.                 Else
    
11.                     Set Rng = Union(Rng, .Rows(i + 1))              'Union 方法: 傳回兩個或多個範圍的合併範圍。
    
12.                 End If
    
13.             End If
    
14.         Next
    
15.         If Not Rng Is Nothing Then Rng.Delete                        '刪除
    
16.     End With
    
17. End Sub

複製代碼

准提部林

假如資料這麼有規則．參考：

1. Sub Macro1()
   
2. Dim xU As Range
   
3. Sheets("PKG").UsedRange.Copy [工作表2!A1] '貼入全部資料
   
4. Set xU = [工作表2!D:D].SpecialCells(xlCellTypeConstants, 2) '取得"PC"字樣全部儲存格
   
5. xU.Offset(1, -3).ClearContents '清除[箱號]下方數字
   
6. With xU.Offset(, -2)
   
7. 　　　.Item(1).Delete Shift:=xlUp 'B欄上移一格
   
8. 　　　.EntireRow.Delete '刪去列
   
9. End With
   
10. End Sub

複製代碼

或：

1. Sub Macro2()
   
2. Sheets("PKG").UsedRange.Copy [工作表2!A1]
   
3. With [工作表2!D:D].SpecialCells(xlCellTypeConstants, 2).Offset(, -2)
   
4. 　　　.Offset(1, -1).ClearContents '清除[箱號]下方數字
   
5. 　　　.Item(1).Delete Shift:=xlUp 'B欄上移一格
   
6. 　　　.EntireRow.Delete '刪去列
   
7. End With
   
8. End Sub

複製代碼

lionliu

回復 2# GBKEE
謝謝兩位大哥回覆，現進行測試。