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

av8d

A1 B1 C1 D1  分別為  編號  單位  姓名  職稱
資料筆數不定
一般核對資料時都是把我擁有的選取~
找出剩下沒被選取的~

我該如何快速複製這些剩下沒被選曲的呢?
因為經常使用~每次都必須輸寫註記在選取這些沒被選取的~
非常麻煩~請教各位大大了

yen956

回復 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
    
14. 
    
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

複製代碼

av8d

回復 2# yen956


    太神啦!
我想詢問一下~如果我想修改成複製選取的~該如何改?
我先研究一下~再次感謝

yen956

補充說明：
在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.

yen956

回復 3# av8d
大大你好, 什麼叫【複製選取】?
可不可以舉例(或附檔)說明.

yen956

回復 4# yen956
對不起, 弄錯了!!
錯誤:
例如從 A1 移到 B2, 則 Target=A1, 並對整張 Worksheet 有效,
更正:
例如從 A1 移到 B2, 則 Target=B2, 並對整張 Worksheet 有效,

av8d

回復 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()內容~謝謝

av8d

回復 7# av8d


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

yen956

回復 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

av8d

回復 9# yen956


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

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

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

再次麻煩大大~謝謝