[發問] 是否有辦法框選範圍以值的方式下移不改變儲存格公式??

a31075ha

[attach]16843[/attach]

因為報表內含有很多公式及很多voolkup的欄位 也有時間計算的格式我試著插入列後下移公式  公式會整個亂掉
是否有辦法框選我要下移的範圍列數 按按鈕後 自動將第7欄 跟第15欄(綠色欄位)及我所框選的列數以值的方式下移或者上移
而上或下如有資料而不覆蓋

a31075ha

下載 (146.67 KB)

2013-11-23 16:24

範例圖

a31075ha

回復 2# a31075ha

應該是說框選後 只計算要下移的列數而會下移的只有第7跟第15欄 有點語無倫次 = ="

luhpro

因為報表內含有很多公式及很多voolkup的欄位 也有時間計算的格式我試著插入列後下移公式  公式會整個亂 ...
a31075ha 發表於 2013-11-23 16:17

a31075ha 說 :
而上或下如有資料而不覆蓋 <=== 這句話不易理解, 希望能舉例一下.
至於往下移動的方式,這裡拋磚引玉一下: (以下程式 Mark 區域不限所選的欄位,只取所作用的列範圍)

1. Sub 往下移動()
   
2.   Dim lRow&, lRows&
   
3.   Dim rTar As Range
   
4. 
   
5.   Set rTar = Selection
   
6.   If rTar.Count = 1 Then
   
7.     lRows = 1
   
8.   Else
   
9.     lRows = UBound(rTar.Value2, 1)
   
10.   End If
    
11.   icol = 7
    
12.   Do While icol < 16
    
13.     Range(Cells(rTar.Row, icol), Cells(Rows.Count, icol).End(xlUp)).Copy _
    
14.     Cells(rTar.Row + lRows, icol)
    
15.     'Range(Cells(rTar.Row, icol), Cells(rTar.Row + lRows - 1, icol)) = ""  ' 不確定你是否要清掉這些資料
    
16.     icol = icol + 8
    
17.   Loop
    
18. End Sub

複製代碼

a31075ha

回復 4# luhpro

下載 (104.2 KB)

2013-11-24 21:42

不知道是否有辦法像圖中黑色部份一樣 下移後不是變成2個5而是將原本的清除掉

而上或下如有資料而不覆蓋<<---以下範例

下載 (111.62 KB)

2013-11-24 22:08

黃色部份是已完成製作的部分 綠色部分是正在製作
如果往上移動是否有辦法移動到綠色部分有資料後就不再移動 才不會造成把完成的資料覆蓋掉或者變動到.

感謝大大你 因改成自帶資料跟公式的表格後 才發現常需要更改順序 而插入會整個亂掉...= ="

luhpro

回復  luhpro
不知道是否有辦法像圖中黑色部份一樣 下移後不是變成2個5而是將原本的清除掉
而上或 ...
a31075ha 發表於 2013-11-24 22:21

1. 要將原本的資料清除掉, 把上面 4# 所提程式 15. 中的 ' 去掉就是你要的功能了:

Range(Cells(rTar.Row, icol), Cells(rTar.Row + lRows - 1, icol)) = ""  ' 不確定你是否要清掉這些資料

2. 而上或下如有資料而不覆蓋<<---以下範例
其中 "上如有資料而不覆蓋",
依下圖所述看起來我猜你要的應該是 :
去掉空白的儲存格.
若是的話, 那此時應該是不需要管使用者到底是 Mark 哪些儲存格,
都只做 去掉空白的儲存格 這個動作,
以下程式針對 G 與 O 兩欄去掉所有的空白儲存格.

1. Sub 往上移動()
   
2.   Dim lRow&, lBRow&, lERow&
   
3.   Dim rTar As Range
   
4.   
   
5.   icol = 7
   
6.   Do While icol < 16
   
7.     lRow = Cells(5, icol).End(xlDown).Row
   
8.     lERow = Cells(Rows.Count, icol).End(xlUp).Row
   
9.     lBRow = Cells(lRow, icol).End(xlDown).Row
   
10.    
    
11.     Do While lRow <> lERow
    
12.       Range(Cells(lBRow, icol), Cells(lERow, icol)).Copy Cells(lRow + 1, icol)
    
13.       Range(Cells(lERow - lBRow + lRow + 2, icol), Cells(lERow, icol)) = ""
    
14.       lRow = Cells(5, icol).End(xlDown).Row
    
15.       lERow = Cells(Rows.Count, icol).End(xlUp).Row
    
16.       lBRow = Cells(lRow, icol).End(xlDown).Row
    
17.     Loop
    
18.     icol = icol + 8
    
19.   Loop
    
20. End Sub

複製代碼

不過, "下如有資料而不覆蓋" - 這個可能會有疑慮,
以黑格那欄來看,原先的排列是:

1 2 3 4 空格 5 6 7 8 ~

若我 Mark 3 4 那兩個儲存格的列,
再按 往下移動 鈕,
那結果到底應該是 :

1 2 空格 空格 3 4 空格 5 6 7 8 ~  (3 及其以下全部往下移兩列)

還是

1 2 空格 空格 3 5 6 7 8 ~  (3 與 4 往下移兩列, 但 4 所移目的格已有 5 所以不覆蓋, 3 變不見了)

呢?


另外, 我倒覺得你要的可能只是:
插入一些資料到目前的資料序列中,
若真是這個需求, 那程式又會與上面不一樣了.

不知你的需求是哪個?

a31075ha

回復 6# luhpro


    大大感謝你 這樣就很夠用了   因為原本想說會是選取範圍整個往下移動 所以怕會有資料沒被選到而被覆蓋掉
    不過既然整個往下 那就不會有這個問題了....往上只要不去動到已經完成的資料 所以刪掉空格也解決了這個問題
總之感謝大大解決我的困饒 表單用了太多公式 函式了 ... = ="

a31075ha

回復 6# luhpro

另外, 我倒覺得你要的可能只是:
插入一些資料到目前的資料序列中,
若真是這個需求, 那程式又會與上面不一樣了.
----------------------------------------------
大大我的確是要插入一些資料到目前的資料序列中
只是因為表單里就這二欄式必須自己KEY上去 其他都是公式設定好換算
我試過插入列後下拉公式也會跑掉 很多也會換算上一列資料 跟時間換算..
所以才想有甚麼辦法可以上下移動資料

luhpro

回復  luhpro
大大我的確是要插入一些資料到目前的資料序列中 ...
a31075ha 發表於 2013-11-26 01:37

依你的需求重寫程式如下:
以下程式放在 Module

1. Public bOK As Boolean
   
2. Public rTar As Range

複製代碼

以下程式放在要插入資料的Sheet

1. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   
2.   Set rTar = Target
   
3.   ufMain.Show
   
4.   If bOK Then Cancel = True
   
5. End Sub

複製代碼

以下程式放在 Module (更名為 ufMain, 建兩個TextBox 分別命名為 tbColG 與 tbColO, 建兩個 Buttom 分別命名為 cbCancel 與 cbOK )

1. Private Sub cbCancel_Click()
   
2.   bOK = False
   
3.   ufMain.Hide
   
4. End Sub
   
5. 
   
6. Private Sub cbOK_Click()
   
7.   Dim lRow&, lRows&, lI&
   
8.   Dim arData
   
9.   
   
10.   bOK = True
    
11.   If tbColO.Text = "" Then tbColO.Text = tbColG.Text
    
12.   With rTar.Parent
    
13.     icol = 7
    
14.     arData = Split(tbColG.Text, Chr(13) & Chr(10))
    
15.     lRows = UBound(arData, 1)
    
16.     lRow = rTar.Row
    
17.     .Range(.Cells(lRow, icol), .Cells(Rows.Count, icol).End(xlUp)).Copy .Cells(lRow + lRows + 1, icol)
    
18.     .Range(.Cells(lRow, icol), .Cells(lRow + lRows, icol)) = ""
    
19.     .Cells(lRow, icol).Resize(lRows + 1) = Application.Transpose(arData)
    
20.    
    
21.     icol = 15
    
22.     arData = Split(tbColO.Text, Chr(13) & Chr(10))
    
23.     lRows = UBound(arData, 1)
    
24.     lRow = rTar.Row
    
25.     .Range(.Cells(lRow, icol), .Cells(Rows.Count, icol).End(xlUp)).Copy .Cells(lRow + lRows + 1, icol)
    
26.     .Range(.Cells(lRow, icol), .Cells(lRow + lRows, icol)) = ""
    
27.     .Cells(lRow, icol).Resize(lRows + 1) = Application.Transpose(arData)
    
28.    
    
29.     With ufMain
    
30.       .tbColG.Text = ""
    
31.       .tbColO.Text = ""
    
32.       .Hide
    
33.     End With
    
34.   End With
    
35. End Sub

複製代碼

觸發方式為 :
1. 任意 Mark 儲存格並對 Mark 的區域按滑鼠右鍵. (程式只會用到第一個儲存格的列號, 作為插入資料的起始列號)
2. 程式會開一個 UserForm 內含兩個輸入區, 分別用於輸入要插入 欄G 與 欄O 的資料.
(若要插入的資料不只一筆, 請按 Ctrl+Enter 換列輸入, 每一列視為一筆資料, 兩欄的資料 "筆數" 可以不相等,
若 欄O的輸入區 未輸入資料, 則會將 欄G 的資料 Copy 過去 欄O , 即兩欄都會新增相同的資料.)
3. 若按下 "取消" 按紐,  UserForm 會關閉, 接著恢復顯示一般 "在儲存格按右鍵" 後會顯示的快捷列 (即仍有保留原先按滑鼠右鍵的功能).
4. 若按下 "確定" 按紐, 會先執行插入資料的作業, 再關閉 UserForm, 且快捷列改為不顯示.

範例程式如下:
MoveVol-a.zip (13.71 KB)

下載次數: 7

2013-11-26 22:13

a31075ha

回復 9# luhpro


    感謝你 我再試看看.....菜鳥摸索中 感恩..............