以"指定字"作為copy並貼上值的指定範圍 - Excel程式區

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

11^# 跳轉到 »

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

回復 6# PJChen
.Range(Rng(1), Rng(2)).Resize(, 12).Copy Destination:=Sheets(2).Range("A1")
這Sheets(2) 是哪個活頁簿的第2個工作表
PKG.xlsx , Shipping VBA.xlsm 都找不到這程式可以執行嗎?

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

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

12^#

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

回復 10# c_c_lai
謝謝你這麼熱心,你將巨集中的以下這3行變成沒有作用,我知道這三行取消後有公式的地方就不會亂碼,但這不是我要的,
' Sheets("PKG").Select
' Columns("R:AC").Select
' Selection.Delete Shift:=xlToLeft
重點應該放在          .Range(Rng(1), Rng(2)).Resize(, 11).Copy ....這行執行了以後只有copy沒有辦法在選取的範圍中貼上值,只要這個可以"起作用",其它有公式的部份就都不是問題,至於以下的6行是我一定要執行的,不能刪除.
Sheets("PKG").Select
   Columns("R:AC").Select
   Selection.Delete Shift:=xlToLeft
Columns("A:C").Select
Range("C11").Activate
Selection.Delete Shift:=xlToLeft

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

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

13^#

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

回復 11# GBKEE

VBA TEST.zip (35.83 KB)
Hi,

我將這個程式分階段執行了很多次,知道這個旨令沒有寫完,它只到copy並沒有在原指定範圍中貼上值,而且以下這樣做並不合乎我想要以"指定文字"作為設定的範圍, .Range(Rng(1), Rng(2)).Resize(, 12).Copy Destination:=Sheets(2).Range("A1")
請幫我看看附件,我已將巨集程式 copy進去,只是不知道.Range(Rng(1), Rng(2)).Resize(, 12).Copy之後如何做?
我不是要在其它的sheet .Range("A1")中貼上值,而是要讓它在原設定的範圍貼上值,請幫幫忙.

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 270
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-11-4

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

14^#

發表於 2012-4-28 21:29 | 只看該作者

本帖最後由 Hsieh 於 2012-4-28 21:37 編輯

回復 13# PJChen

請依照目前PKG現有資料，你想要的最後結果用手動操作完成上傳
因為以你錯誤的程式碼是無法了解你要的目的為何
如果單純將該範圍轉成值

Sub Try()
With Workbooks("PKG.xlsx")
With .Sheets("PKG")
Set a = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
Set b = .Range("D:D").Find("PACKING:")
If a Is Nothing Or b Is Nothing Then
MsgBox "找不到"
Else
.Range(a, b.Offset(, 11)) = .Range(a, b.Offset(, 11)).Value
End If
End With
End With
End Sub

複製代碼

至於其他動作請描述清楚

學海無涯_不恥下問

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

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

15^#

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

回復 14# Hsieh

謝版大,
執行後沒有問題,但請指教一個範圍上的問題:
b的範圍這樣寫可以向右延伸12格....... b.Offset(, 12)
那如果a的範圍我想向上走11格,我改為以下,為什麼它不能執行?
.Range(a.Offset(, -11), b.Offset(, 12)) = .Range(a.Offset(, -11), b.Offset(, 12)).Value

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 270
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-11-4

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

16^#

發表於 2012-4-28 22:14 | 只看該作者

回復 15# PJChen

有2個問題
1.向上11格式Offset(-11,0)
2.如果a的位置在1到11列之間，那麼，向上11列就會超出工作表範圍，所以出錯。

學海無涯_不恥下問

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

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

17^#

發表於 2012-4-28 22:24 | 只看該作者

回復 16# Hsieh
不好意思版大,
由"Shipped per SS:"向上11格(儲存格D4)在我的工作表上是沒有超出範圍,但我故意在D4放置了公式,修改為以下的樣子,
貼上值之後D4公式還在,所以 .Range(a.Offset(-11, 0)並沒有向上11格,我該怎麼辦?
如果你需要看檔案,我上傳了

VBA TEST.zip (35.29 KB)
.Range(a.Offset(-11, 0), b.Offset(, 12)) = .Range(a.Offset(-11, 0), b.Offset(, 12)).Value

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 270
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2025-11-4

2024年全勤獎章 2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

18^#

發表於 2012-4-28 23:00 | 只看該作者

回復 17# PJChen

D19是變數a的位置，向上11列也只到D8
你忽略了14到18列被隱藏，沒算這4列所以範圍沒包含D4

學海無涯_不恥下問

TOP

PJChen

　暱稱: PJ

大學生 Rank: 4

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

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

19^#

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

回復 18# Hsieh

謝謝版大,
原來是自已大意

TOP

c_c_lai

博士班 Rank: 6 Rank: 6

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

20^#

發表於 2012-4-29 06:40 | 只看該作者

本帖最後由 c_c_lai 於 2012-4-29 06:42 編輯

回復 19# PJChen
這是不是妳要的？

Sub Try()
Dim Rng(1 To 2) As Range
Windows("PKG.xlsx").Activate
' 加入 Hsieh 先進的引用方法
With Workbooks("PKG.xlsx")
With .Sheets("PKG")
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 ' 依照 Hsieh 先進的指示，稍加修飾
.Range(Rng(1), Rng(2).Offset(, 11)) = .Range(Rng(1), Rng(2)).Resize(, 12).Value
End If
End With
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
ActiveWorkbook.SaveAs "D:\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

複製代碼

VBA TEST.rar (55.82 KB)

TOP

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

[收藏此主題] [關注此主題的新回復]

[通過 QQ、MSN 分享給朋友]