麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 錄製後迴圈設定及插入複製的儲存格是否可以不插入圖案 [打印本頁]

作者: jackson7015 時間: 2016-6-4 16:28 標題: 錄製後迴圈設定及插入複製的儲存格是否可以不插入圖案

想請問站上的前輩們
我有一錄製的巨集想做InputBox數量迴圈
請問該如何編寫

Sub 新增數量()
Rows("1:47").Select
Selection.Copy
Rows("48:48").Select
Selection.Insert Shift:=xlDown
Range("A4").Activate
End Sub

複製代碼

還有我在上面的巨集中，負制的範圍有包含到圖片圖案
是否有不插入圖片圖案的方式
因為直接從48行插入，就不需要做行數判定，可以選擇格式設定

以上問題再請大大幫忙，感謝~

作者: jackyq 時間: 2016-6-5 18:27

有無直接的指令?  不曉得耶

用插入後再把圖刪除的方法

Sub kill_Image(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 x2 <= R_y2

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

作者: ML089 時間: 2016-6-5 23:45

回復 1# jackson7015

Sub 新增數量()
Dim Rng As Range
Set Rng = Rows("1:47")
Rng.Copy
With Rows("48:48").Resize(, Rng.Rows.Count) 'columns/rows
      .PasteSpecial Paste:=xlPasteFormats '格式
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats '值
      .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats '公式
End With
End Sub

作者: jackson7015 時間: 2016-6-7 14:58

本帖最後由 jackson7015 於 2016-6-7 15:01 編輯

回復 2# jackyq
回復 3# ML089
感謝jackyq及ML089回覆

jackyq大大的測試後可以使用，但是需要多幾個步驟，所以之後有類似的需求可以再使用，感謝~

ML089大大的寫法，好像無法將格式所有複製，因為儲存格內文字大小及跨欄置中都沒有出現
因為有部分儲存格內有填入顏色，是否也可以以插入的方式做處理?
謝謝~

作者: jackyq 時間: 2016-6-7 16:20

回復 4# jackson7015

因為 Excel 2000 沒法用 #3樓的方法

作者: jackyq 時間: 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

作者: jackson7015 時間: 2016-6-8 15:25

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

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

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

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

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

作者: jackyq 時間: 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

作者: jackyq 時間: 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

作者: ML089 時間: 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

作者: jackson7015 時間: 2016-6-14 15:58

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

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

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

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

作者: jackson7015 時間: 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
但是使用手動複製插入卻不會有此問題
不曉得有大大有這種問題否?
[attach]24491[/attach]

作者: jackyq 時間: 2016-6-14 18:22

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

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

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

作者: jackson7015 時間: 2016-6-15 15:20

回復 13# jackyq

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

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

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

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)