麻辣家族討論版版 » Excel程式區 » 以"指定字"作為copy並貼上值的指定範圍

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

[發問] 以"指定字"作為copy並貼上值的指定範圍

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 倒序看帖

字體大小: tT

發表於 2012-4-28 15:08 | 只看該作者

[發問] 以"指定字"作為copy並貼上值的指定範圍

巨集中的指定範圍作copy並貼上值的動作,能否以"指定字"作為copy並貼上值的指定範圍?這個用意是在於工作表的資料有增加或減少時,用"指定字"作為範圍才不需要不斷的去修改巨集程式,請大家幫幫忙!
例如:D19:O133
以"Shipped per SS: "字樣為開始(D19),以"PACKING:"向右+11個儲存格(即O133)為結束

PKG.zip (19.34 KB)

樓主熱帖

收藏

超級版主 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^#

發表於 2012-4-28 16:07 | 只看該作者

回復 1# PJChen

Sub Ex()
Dim Rng(1 To 2) As Range
With ActiveSheet
Set Rng(1) = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
Set Rng(2) = .Range("D:D").Find("PACKING:")
If Rng(1) Is Nothing Or Rng(2) Is Nothing Then
MsgBox "找不到"
Else
.Range(Rng(1), Rng(2)).Resize(, 11).Copy
End If
End With
End Sub

複製代碼

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

3^#

發表於 2012-4-28 16:43 | 只看該作者

回復 2# GBKEE
G大,您好

我把您寫的程式套到我的工作表巨集中,但他執行時,無法作copy並貼上值的動作,我在工作表中打了公式作為實驗,結果另存後就都亂碼了,能否幫我看看問題出在哪?

PKG2.zip (20.5 KB)
Windows("PKG.xlsx").Activate

Sheets("PKG").Select

Dim Rng(1 To 2) As Range
With ActiveSheet
      Set Rng(1) = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
      Set Rng(2) = .Range("D:D").Find("PACKING:")
      If Rng(1) Is Nothing Or Rng(2) Is Nothing Then
         MsgBox "找不到"
      Else
         .Range(Rng(1), Rng(2)).Resize(, 11).Copy
      End If
End With

Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
Range("Q122:Q122").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
      :=False, Transpose:=False
ActiveSheet.Paste
Rows("143:143").Select
Selection.ClearContents
Range("C1").Select
End With
ActiveWorkbook.SaveAs "P:\Shipping Doc\PJ\" & [Q5] & "_" & [C6] & " PO#" & [V7] & " by " & [C19] & " to " & [C22] & ".xlsx"

Sheets("PKG").Select
Columns("R:AC").Select
Selection.Delete Shift:=xlToLeft
Columns("A:C").Select
Range("C11").Activate
Selection.Delete Shift:=xlToLeft

ActiveWorkbook.Save

End Sub

超級版主 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兔年全勤獎章

4^#

發表於 2012-4-28 17:06 | 只看該作者

回復 3# PJChen
請先將檔案存有巨集功能的活頁簿為 .xlsm 看看

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

5^#

發表於 2012-4-28 17:10 | 只看該作者

回復 2# GBKEE
剛剛拿瞭這個範例做測試，發現 Resize(, 11) 應為 Resize(, 12)，如此範圍才能到達 D19:O133

Sub Ex()
Dim Rng(1 To 2) As Range
With ActiveSheet
Set Rng(1) = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
Set Rng(2) = .Range("D:D").Find("PACKING:")
If Rng(1) Is Nothing Or Rng(2) Is Nothing Then
MsgBox "找不到"
Else
.Range(Rng(1), Rng(2)).Resize(, 12).Copy Destination:=Sheets(2).Range("A1")
End If
End With
End Sub

複製代碼

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

6^#

發表於 2012-4-28 18:25 | 只看該作者

回復 4# GBKEE
回復 5# c_c_lai

VBA TEST.zip (35.57 KB)

二位好,
二種方式我都試了,還是行不通,我的巨集程式都是另存的,我需的是指定範圍作copy並貼上值的動作,結果另存後就都亂碼了,表示巨集中的"copy並貼上值的動作"並沒有生效!
現在我將作好的檔案上傳,能幫我看看出了什麼問題嗎?

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

7^#

發表於 2012-4-28 19:27 | 只看該作者

本帖最後由 c_c_lai 於 2012-4-28 19:29 編輯

回復 6# PJChen
試試這個：最底下那張圖是不小心附上的，妳就當作沒看到！

Shipping Doc.rar (55.72 KB)

01.gif (117.9 KB)

　暱稱: PJ

大學生 Rank: 4

帖子: 913
主題: 150
精華: 0
積分: 1089
點名: 0
作業系統: win10
軟體版本: office 2019
閱讀權限: 50
性別: 女
註冊時間: 2011-8-28
最後登錄: 2023-7-19

論壇榮譽勳章論壇贊助勳章

8^#

發表於 2012-4-28 19:35 | 只看該作者

回復 7# c_c_lai
Hi,

我看到你上傳執行巨集後的檔,就跟我執行的結果相同,有公式的地方都是亂碼,我知道巨集可以執行但我需的是指定範圍作copy並貼上值的動作,結果另存後就都亂碼了,表示巨集中的"copy並貼上值的動作"並沒有生效!

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

9^#

發表於 2012-4-28 19:58 | 只看該作者

回復 4# GBKEE
回復 8# PJChen
原來指的是這個，G大大這方面您比較在行，換您上場了！

博士班 Rank: 6 Rank: 6

帖子: 2035
主題: 24
精華: 0
積分: 2031
點名: 0
作業系統: Win7
軟體版本: Office2010
閱讀權限: 100
性別: 男
註冊時間: 2012-3-22
最後登錄: 2024-2-1

10^#

發表於 2012-4-28 20:27 | 只看該作者

回復 4# GBKEE
回復 8# PJChen
我找到原因了，如圖示、及代碼 (運算公式)：

' Sheets("PKG").Select ' *****************
' Columns("R:AC").Select ' *****************
' Selection.Delete Shift:=xlToLeft ' *****************
Columns("A:C").Select
Range("C11").Activate
Selection.Delete Shift:=xlToLeft

複製代碼

VBA TEST.rar (56.61 KB)

靜思自在 : 有多少力量就做多少事，不要心存等待，等待才會落空。

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