返回列表下一主題上一主題發帖

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

lionliu

中學生 Rank: 2

帖子: 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

超級版主 Rank: 8 Rank: 8

帖子: 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

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

複製代碼

用刪除

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

複製代碼

感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限, 一天1元的贊助,人人有能力.

TOP

准提部林

版主 Rank: 7 Rank: 7 Rank: 7

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-19

3^#

發表於 2015-9-19 15:44 | 只看該作者

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

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

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

複製代碼

或：

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

複製代碼

TOP

lionliu

中學生 Rank: 2

帖子: 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

靜思自在 : 滴水成河。粒米成蘿，勿輕己靈，勿以善小而不為。

返回列表下一主題上一主題