返回列表 上一主題 發帖

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

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

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

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


Shipping Doc.rar (55.72 KB)

01.gif (117.9 KB)

01.gif

TOP

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

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
複製代碼

VBA TEST.rar (56.61 KB)

TOP

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

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

  1. Sub Try()
  2.     Dim Rng(1 To 2) As Range
  3.    
  4.     Windows("PKG.xlsx").Activate

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

TOP

回復 21# PJChen
Please check the CI12-460_ACE PO#120309 by FEDEX to .xlsx produced  this morning
in D:\Shipping Doc\PJ subdirectory.

TOP

        靜思自在 : 小事不做、大事難成。
返回列表 上一主題