GBKEE

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

PJChen

回復 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

PJChen

回復 11# GBKEE
VBA TEST.zip (35.83 KB)

下載次數: 4

2012-4-28 21:13

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")中貼上值,而是要讓它在原設定的範圍貼上值,請幫幫忙.

Hsieh

回復 13# PJChen

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

1. Sub Try()
   
2. 
   
3. With Workbooks("PKG.xlsx")
   
4.     With .Sheets("PKG")
   
5.         Set a = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
   
6.         Set b = .Range("D:D").Find("PACKING:")
   
7.         If a Is Nothing Or b Is Nothing Then
   
8.             MsgBox "找不到"
   
9.         Else
   
10.             .Range(a, b.Offset(, 11)) = .Range(a, b.Offset(, 11)).Value
    
11.         End If
    
12.     End With
    
13. End With
    
14. End Sub

複製代碼

至於其他動作請描述清楚

PJChen

回復 14# Hsieh

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

Hsieh

回復 15# PJChen

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

PJChen

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

下載次數: 4

2012-4-28 22:23

            .Range(a.Offset(-11, 0), b.Offset(, 12)) = .Range(a.Offset(-11, 0), b.Offset(, 12)).Value

Hsieh

回復 17# PJChen


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

PJChen

回復 18# Hsieh

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

c_c_lai

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

下載 (90.85 KB)

2012-4-29 06:32

下載 (94.91 KB)

2012-4-29 06:33

1. Sub Try()
   
2.     Dim Rng(1 To 2) As Range
   
3.    
   
4.     Windows("PKG.xlsx").Activate
   
5. 
   
6.      '  加入 Hsieh 先進的引用方法
   
7.     With Workbooks("PKG.xlsx")
   
8.         With .Sheets("PKG")
   
9.             Set Rng(1) = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
   
10.             Set Rng(2) = .Range("D:D").Find("PACKING:")
    
11.             
    
12.             If Rng(1) Is Nothing Or Rng(2) Is Nothing Then
    
13.                 MsgBox "找不到"
    
14.             Else     '  依照 Hsieh 先進的指示，稍加修飾
    
15.                .Range(Rng(1), Rng(2).Offset(, 11)) = .Range(Rng(1), Rng(2)).Resize(, 12).Value
    
16.             End If
    
17.         End With
    
18.     End With
    
19.    
    
20.    
    
21.     Selection.Copy
    
22.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
23.         :=False, Transpose:=False
    
24.     Range("Q122:Q122").Select
    
25.     Selection.Copy
    
26.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    
27.         :=False, Transpose:=False
    
28.     ActiveSheet.Paste
    
29.     Rows("143:143").Select
    
30.     Selection.ClearContents
    
31.     Range("C1").Select
    
32.    
    
33.     ActiveWorkbook.SaveAs "D:\Shipping Doc\PJ\" & [Q5] & "_" & [C6] & " PO#" & [V7] & " by " & [C19] & " to " & [C22] & ".xlsx"
    
34.         
    
35.     Sheets("PKG").Select                         ' 恢復原狀
    
36.     Columns("R:AC").Select                    ' 恢復原狀
    
37.     Selection.Delete Shift:=xlToLeft     ' 恢復原狀
    
38.     Columns("A:C").Select
    
39.     Range("C11").Activate
    
40.     Selection.Delete Shift:=xlToLeft
    
41.    
    
42.     ActiveWorkbook.Save
    
43. End Sub

複製代碼

VBA TEST.rar (55.82 KB)

下載次數: 7

2012-4-29 06:39