123
返回列表 上一主題 發帖

[發問] 如何快速複製剩下沒被選曲的?

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
13# 跳轉到 »
發表於 2014-3-16 09:58 | 只看該作者
更動到旁邊 D E, C留給打勾的
本來 欄E 用來打勾,
插入 欄C, 變成 欄C 用來打勾, 其餘向右移?

改變 Worksheet_SelectionChange 的 觸動對像 就可以了,
詳見 4f及6f 的說明

也就是將
    Set rngE = [E1].Resize(end1, 1)
改成
    Set rngE = [C1].Resize(end1, 1)
就可以了

TOP

av8d

帖子
712 
主題
281 
精華
0 
積分
1019 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2025-5-22 
12#
發表於 2014-3-15 20:41 | 只看該作者
本帖最後由 av8d 於 2014-3-15 21:09 編輯
  1. Private Sub CommandButton1_Click()
  2.     Dim Rng, rngE As Range, row1, i As Integer
  3.    
  4.     Dim sh1, sh3 As Object
  5. '   Set sh1 = ThisWorkbook.Sheets("Sheet1")
  6.     Set sh3 = ThisWorkbook.Sheets("工作表3")
  7.    
  8.     end1 = [A65536].End(xlUp).Row
  9.     Set rngE = [E2].Resize(end1, 1)
  10.     i = 2
  11.     For Each Rng In rngE
  12.         If Rng = "v" Then
  13.             Cells(Rng.Row, 1).Resize(1, 4).Copy
  14.             row1 = [I65536].End(xlUp).Offset(1, 0).Row
  15.             Cells(row1, 9).Resize(1, 4).Select
  16.             ActiveSheet.Paste
  17.         End If
  18.         sh3.Activate
  19.         If Rng = "v" Then
  20.             Cells(Rng.Row, 1).Resize(1, 4).Copy
  21.             sh3.Cells(i, 2).Select
  22.             ActiveSheet.Paste
  23.             i = i + 1
  24.         End If
  25.     Next
  26. End Sub
複製代碼
結合後變成這樣?但是會出現錯誤

    更動到旁邊 D E
C留給打勾的

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
11#
發表於 2014-3-15 13:37 | 只看該作者
問題一：
如果要複製到右邊又要複製到Sheet3兩種都要有該如何做呢?
不是兩個程序合併起來就好了嗎?
﹝執行﹞複製到右邊
﹝執行﹞複製到Sheet3
問題二(進階題)：
把打勾的地方改成
原本A,B,C,D,打勾
改成A,B,打勾,C,D位置更動，
C,D位置更動  要改到那裡?

TOP

av8d

帖子
712 
主題
281 
精華
0 
積分
1019 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2025-5-22 
10#
發表於 2014-3-14 18:03 | 只看該作者
回復 9# yen956


    大大~謝謝你~太厲害了~

我想再問一個問題~這問題沒解開沒關係~
因為有點複雜~有些難度~
問題一：
如果要複製到右邊又要複製到Sheet3兩種都要有該如何做呢?

問題二(進階題)：
如果
把打勾的地方改成
原本A,B,C,D,打勾
改成A,B,打勾,C,D
位置更動，這樣似乎會比較方便使用者~但是會讓變得不好寫~

再次麻煩大大~謝謝

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
9#
發表於 2014-3-14 13:07 | 只看該作者
回復 8# av8d
試試看:
Private Sub CommandButton1_Click()
    Dim Rng, rngE As Range, row1, i As Integer
   
    Dim sh1, sh3 As Object
'   Set sh1 = ThisWorkbook.Sheets("Sheet1")
    Set sh3 = ThisWorkbook.Sheets("Sheet3")
   
    end1 = [A65536].End(xlUp).Row
    Set rngE = [E2].Resize(end1, 1)
    i = 2
    sh3.Activate
    For Each Rng In rngE
        If Rng = "v" Then
            Cells(Rng.Row, 1).Resize(1, 4).Copy
            sh3.Cells(i, 2).Select
'            row1 = [I65536].End(xlUp).Offset(1, 0).Row
'            Cells(row1, 9).Resize(1, 4).Select
            ActiveSheet.Paste
            i = i + 1
        End If
    Next
End Sub

TOP

av8d

帖子
712 
主題
281 
精華
0 
積分
1019 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2025-5-22 
8#
發表於 2014-3-14 11:28 | 只看該作者
回復 7# av8d


    剩下問題3
要複製到Sheet3的B2

TOP

av8d

帖子
712 
主題
281 
精華
0 
積分
1019 
點名
0  
作業系統
Windows 10 
軟體版本
Office 2019 
閱讀權限
50 
性別
男 
註冊時間
2011-6-30 
最後登錄
2025-5-22 
7#
發表於 2014-3-14 10:13 | 只看該作者
本帖最後由 av8d 於 2014-3-14 10:27 編輯

回復 5# yen956


    956大大~真不好意思~最近比較忙那麼晚才回覆您~
我把疑問一一列出

1.非打勾的複製~改成打勾的複製~該如何改寫
測試OK
If Rng = "v" Then

2.如果要複製到J到M欄~該如何寫
3.如果要複製到Sheet3~該如何寫
4.如果E欄改成F欄~該如何改寫
5.如果只要複製B和D欄~該如何改寫

6.如果只要複製B到D欄~該如何改寫
測試OK
Cells(Rng.Row, 2).Resize(1, 4).Copy

如果方便的話可否解說關於Private Sub CommandButton1_Click()內容~謝謝

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
6#
發表於 2014-3-12 23:17 | 只看該作者
回復 4# yen956
對不起, 弄錯了!!
錯誤:
例如從 A1 移到 B2, 則 Target=A1, 並對整張 Worksheet 有效,
更正:
例如從 A1 移到 B2, 則 Target=B2, 並對整張 Worksheet 有效,

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
5#
發表於 2014-3-12 17:42 | 只看該作者
回復 3# av8d
大大你好, 什麼叫【複製選取】?
可不可以舉例(或附檔)說明.

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
4#
發表於 2014-3-12 17:41 | 只看該作者
本帖最後由 yen956 於 2014-3-12 17:44 編輯

補充說明：
在VBA編輯器中, Double Click 左邊的 "sheet1"...等,
會出現 空白編輯視窗,
按下 空白編輯視窗 正上方的 下拉式選單, 選取 "Worksheet",
右邊的 下拉式選單 中, 選取 "SelectionChange",
就會自動跳出:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
之後你在 "sheet1"... 如有 SelectionChange 的動作,
就會觸動此副程式, 並將 Cell 附予 Target,
例如從 A1 移到 B2, 則 Target=A1, 並對整張 Worksheet 有效,
但 Intersect(Target, rngE) 可將 SelectionChange
的有效範圍限制在 rngE 中,
    If Not Intersect(Target, rngE) Is Nothing Then
    End If
Not Intersect(Target, rngE) Is Nothing→負負得正
→表示 Target 並非 Nothing.

TOP

        靜思自在 : 稻穗結得越飽滿，越會往下垂，一個人越有成就，就要越有謙沖的胸襟。
123
返回列表 上一主題