[發問] 錄製後迴圈設定及插入複製的儲存格是否可以不插入圖案

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

14^#

發表於 2016-6-15 15:20 | 只看該作者

回復 13# jackyq

我把電腦重新開機後，excel就正常，沒有錯誤訊息
所以不會卡在貼上的程式序上了

之前因為有錯誤訊息，所以剛好跑到"插入空白列"就停止貼上了

目前程式以正常運作了
感謝各位大大的幫忙！！

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-27

13^#

發表於 2016-6-14 18:22 | 只看該作者

方法2
假設你的資料列在 1 ~ 77 都有資料
如果你在 48 列用  Paste  貼入 30列
那麼原先的 48 ~ 77 列資料都會被覆蓋掉

所以
先用 "插入空白列" 把 48 ~ 77 列的資料往後移動 ( 插入無法選擇不貼圖, 所以這裡只插入空白列 )
再用 PasteSpecial  把資料複製到剛剛插入的空白列  ( PasteSpecial  可以選擇不貼圖 )

這樣結合就避開了  insert 會貼入圖片, PasteSpecial  會覆蓋掉舊有的資料區

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

12^#

發表於 2016-6-14 16:16 | 只看該作者

本帖最後由 jackson7015 於 2016-6-14 16:17 編輯

回復 ML089
回復 jackyq
先感謝兩位大大的協助！

jackyq大大的方法1.在R_Insert.Insert Shift:=xl ...
jackson7015 發表於 2016-6-14 15:58

測試多次後發現，不曉得為什麼插入的程式都會出現程式錯誤，導致程式關閉
Selection.Insert Shift:=xlDown
但是使用手動複製插入卻不會有此問題
不曉得有大大有這種問題否?

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

11^#

發表於 2016-6-14 15:58 | 只看該作者

回復 10# ML089
回復 10# jackyq
先感謝兩位大大的協助！

jackyq大大的方法1.在R_Insert.Insert Shift:=xlDown會出現錯誤，整個程式會關閉，不曉得原因
方法2.插入時會先插入47列的空白，然後才正常插入複製的格式，不曉得哪裡需要更正

ML089大大的公式測試後，發現只有複製的動作，沒有出現貼上或插入的動作

目前想使用方法2的方式把插入次數 = [A2]，然後再做一些判定選項就好了
不過目前大大的公式好像有bug，會出現插入空白列
再請大大幫忙看看是否哪裡有錯誤，感謝~

版主 Rank: 7 Rank: 7 Rank: 7

ML089

帖子: 2025
主題: 13
精華: 0
積分: 2053
點名: 0
作業系統: WIN7
軟體版本: Office2007
閱讀權限: 100
性別: 男
來自: 台北市
註冊時間: 2011-3-2
最後登錄: 2024-3-14

論壇榮譽勳章論壇贊助勳章熱烈參與勳章 2014馬年全勤獎章 2015羊年全勤獎章 2016猴年全勤獎章

10^#

發表於 2016-6-9 00:19 | 只看該作者

回復 4# jackson7015
這樣試試

Sub 新增數量()
Dim Rng As Range
Application.DisplayAlerts = False
Set Rng = Rows("1:47")
Rng.Copy
Rows("48:48").Resize(, Rng.Rows.Count).PasteSpecial Paste:=xlPasteAll
Application.DisplayAlerts = True
End Sub

{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-27

9^#

發表於 2016-6-8 17:52 | 只看該作者

方法2

Sub 新增數量_2()
插入次數 = 5

Set R_Copy = Rows("1:47")
Set R_Insert = Rows("48:48")

Application.CutCopyMode = False
R_Insert.Resize(插入次數 * R_Copy.Rows.Count).Insert
R_Copy.Select
R_Copy.Copy
Set R_Insert = R_Insert.Offset(-R_Copy.Rows.Count * 插入次數)
For w = 1 To 插入次數
      R_Insert.PasteSpecial
      Set R_Insert = R_Insert.Offset(R_Copy.Rows.Count)
Next
End Sub

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-27

8^#

發表於 2016-6-8 17:03 | 只看該作者

回復 7# jackson7015

我知道你用 insert 是為了方便不用計算區塊大小
但 insert 好像沒有參數讓你選擇排除哪些

Sub 新增數量()

插入次數 = 5

Set R_Copy = Rows("1:47")
Set R_Insert = Rows("48:48")

For w = 1 To 插入次數
R_Copy.Select
R_Copy.Copy
R_Insert.Insert Shift:=xlDown
Next

Set R_Insert = R_Insert.Offset(-R_Copy.Rows.Count * 插入次數)
Set R_Insert = R_Insert.Resize(R_Copy.Rows.Count * 插入次數)
Call kill_Image(R_Insert)
End Sub

Sub kill_Image(ByVal R_指定範圍 As Range)

R_x1 = R_指定範圍.Left
R_x2 = R_指定範圍.Left + R_指定範圍.Width
R_y1 = R_指定範圍.Top
R_y2 = R_指定範圍.Top + R_指定範圍.Height

For Each p In R_指定範圍.Parent.Pictures
x1 = p.Left
x2 = p.Left + p.Width
y1 = p.Top
y2 = p.Top + p.Height

xx = x1 >= R_x1 And x1 <= R_x2 Or x2 >= R_x1 And x2 <= R_x2
yy = y1 >= R_y1 And y1 <= R_y2 Or y2 >= R_y1 And y2 <= R_y2

If xx And yy Then
   p.Delete
End If
Next
End Sub

帖子: 233
主題: 53
精華: 0
積分: 292
點名: 0
作業系統: WinXp
軟體版本: 2010
閱讀權限: 20
性別: 男
註冊時間: 2012-1-6
最後登錄: 2024-3-8

論壇贊助勳章

7^#

發表於 2016-6-8 15:25 | 只看該作者

回復 6# jackyq
感謝jackyq大大熱心的幫忙
7、13的確可以使用；所有格式都能[貼上]
且不會帶入圖形

可是小弟需要的功能是以插入複製儲存格的方式
這樣不用再判斷要多少格在[貼上]
因為需要的頁數每次不定
所以想要先出現InputBox詢問插入多少次
然後做迴圈式的重覆插入即可

但是錄製的時候發現[插入複製的儲存格]不能連續動作
複製一次只能插入一次，就需要再複製一次才能繼續動作
所以想請教大大是否有辦法做出連續插入儲存格(不要圖形)的方式

不然可能就要做判斷行數後，以[貼上]的方式做處理了

以上不曉得會不會說得太複雜
再請前輩們看看，感謝~

帖子: 319
主題: 6
精華: 0
積分: 309
點名: 0
作業系統: xp
軟體版本: 2k
閱讀權限: 20
性別: 男
註冊時間: 2015-6-24
最後登錄: 2024-4-27

6^#

發表於 2016-6-8 14:34 | 只看該作者

回復 4# jackson7015

大大這樣試試看吧

........
With Rows("48:48").Resize(, Rng.Rows.Count) 'columns/rows
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
Rows("48:48").PasteSpecial Paste:= 7
Rows("48:48").PasteSpecial Paste:= 13
Rows("48:48").PasteSpecial Paste:= .....  ' 逐次添加缺少的
Rows("48:48").PasteSpecial Paste:= .....  ' 逐次添加缺少的

參數自己 try
https://msdn.microsoft.com/en-us/library/bb241405%28v=office.12%29.aspx