返回列表 上一主題 發帖

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

lionliu

帖子
97 
主題
26 
精華
0 
積分
158 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
男 
來自
taichung 
註冊時間
2010-9-12 
最後登錄
2019-8-29 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-9-19 11:51 | 只看該作者

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

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

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

准提部林

帖子
2833 
主題
10 
精華
0 
積分
2889 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-17 
3#
發表於 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
複製代碼

TOP

lionliu

帖子
97 
主題
26 
精華
0 
積分
158 
點名
0  
作業系統
windows 
軟體版本
office2010 
閱讀權限
20 
性別
男 
來自
taichung 
註冊時間
2010-9-12 
最後登錄
2019-8-29 
4#
發表於 2015-9-20 10:32 | 只看該作者
回復 2# GBKEE
謝謝兩位大哥回覆，現進行測試。
lionliu

TOP

        靜思自在 : 一個人的快樂．不是因為他擁有得多，而是因為他計較得少。
返回列表 上一主題