Board logo

標題: 各位大哥好請問一個表單轉換巨集問題 [打印本頁]
作者: lionliu    時間: 2015-9-19 11:51     標題: 各位大哥好請問一個表單轉換巨集問題

各位大哥好:
我友有個表單轉換的巨集問題，不知錯在哪裡。
附上我的巨集檔，我想讓sheet(1)轉換sheet(3)。
[attach]22035[/attach]
作者: GBKEE    時間: 2015-9-19 13:16

本帖最後由 GBKEE 於 2015-9-20 06:33 編輯

回復 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
複製代碼
作者: 准提部林    時間: 2015-9-19 15:44

本帖最後由 准提部林 於 2015-9-19 15:49 編輯

假如資料這麼有規則．參考：
  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    時間: 2015-9-20 10:32

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



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