返回列表 上一主題 發帖

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

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
1# 跳轉到 »
發表於 2014-3-11 19:55 | 顯示全部帖子
回復 1# av8d
是不是這個意思?
  1. Private Sub CommandButton1_Click()
  2.     Dim Rng, rngE As Range, row1 As Integer
  3.     end1 = [A65536].End(xlUp).Row
  4.     Set rngE = [E2].Resize(end1, 1)
  5.     For Each Rng In rngE
  6.         If Rng = "" Then
  7.             Cells(Rng.Row, 1).Resize(1, 4).Copy
  8.             row1 = [I65536].End(xlUp).Offset(1, 0).Row
  9.             Cells(row1, 9).Resize(1, 4).Select
  10.             ActiveSheet.Paste
  11.         End If
  12.     Next
  13. End Sub

  15. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  16.     Dim rngE As Range
  17.     end1 = [A65536].End(xlUp).Row
  18.     Set rngE = [E1].Resize(end1, 1)
  19.     If Not Intersect(Target, rngE) Is Nothing Then
  20.         If Target = "v" Then
  21.             Target = ""
  22.         Else
  23.             Target = "v"
  24.         End If
  25.     End If
  26. End Sub
複製代碼

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
2#
發表於 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

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
3#
發表於 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 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-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

yen956

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

TOP

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
7#
發表於 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

yen956

帖子
522 
主題
36 
精華
1 
積分
603 
點名
0  
作業系統
win xp sp3 
軟體版本
Office 2003 
閱讀權限
50 
性別
男 
註冊時間
2012-12-13 
最後登錄
2021-7-11 
8#
發表於 2014-3-18 15:17 | 顯示全部帖子
回復 17# Hsieh
還好有大大的幫忙, 不然真會被考倒, 收下啦, 謝謝!!

TOP

        靜思自在 : 生氣，就是拿別人的過錯來懲罰自己。
返回列表 上一主題