返回列表 上一主題 發帖

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

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

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

回復 1# PJChen
  1. Sub Ex()
  2.     Dim Rng(1 To 2) As Range
  3.     With ActiveSheet
  4.         Set Rng(1) = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
  5.         Set Rng(2) = .Range("D:D").Find("PACKING:")
  6.         If Rng(1) Is Nothing Or Rng(2) Is Nothing Then
  7.             MsgBox "找不到"
  8.         Else
  9.             .Range(Rng(1), Rng(2)).Resize(, 11).Copy
  10.          End If
  11.     End With
  12. End Sub
複製代碼

TOP

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

TOP

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

TOP

回復 2# GBKEE
剛剛拿瞭這個範例做測試,發現 Resize(, 11) 應為 Resize(, 12),如此範圍才能到達 D19:O133
  1. Sub Ex()
  2.     Dim Rng(1 To 2) As Range
  3.     With ActiveSheet
  4.         Set Rng(1) = .Range("D:D").Find("Shipped per SS:", LOOKAT:=xlPart)
  5.         Set Rng(2) = .Range("D:D").Find("PACKING:")
  6.         If Rng(1) Is Nothing Or Rng(2) Is Nothing Then
  7.             MsgBox "找不到"
  8.         Else
  9.             .Range(Rng(1), Rng(2)).Resize(, 12).Copy Destination:=Sheets(2).Range("A1")
  10.         End If
  11.     End With
  12. End Sub
複製代碼

TOP

回復 4# GBKEE
回復 5# c_c_lai
VBA TEST.zip (35.57 KB)

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

TOP

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

回復 6# PJChen
試試這個:  最底下那張圖是不小心附上的,妳就當作沒看到!
01.png
2012-4-28 19:26

02.png
2012-4-28 19:26

Shipping Doc.rar (55.72 KB)
01.gif

TOP

回復 7# c_c_lai
Hi,

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

TOP

回復 4# GBKEE
回復 8# PJChen
原來指的是這個,G大大這方面您比較在行,換您上場了!
01.png
2012-4-28 19:58

TOP

回復 4# GBKEE
回復 8# PJChen
我找到原因了,如圖示、及代碼 (運算公式):
  1.     ' Sheets("PKG").Select                           ' *****************
  2.     ' Columns("R:AC").Select                      ' *****************
  3.     ' Selection.Delete Shift:=xlToLeft       ' *****************
  4.     Columns("A:C").Select
  5.     Range("C11").Activate
  6.     Selection.Delete Shift:=xlToLeft
複製代碼
01.png
2012-4-28 20:25

VBA TEST.rar (56.61 KB)

TOP

        靜思自在 : 人的眼睛長在前面,只看到別人的缺點,絲毫看不到自己的缺點。
返回列表 上一主題