想通过宏实现数据移动

gzhdclc

想通过宏实现数据移动：要求为对表格内的任何数据，点击（选中）后，再点任何空白处，数字就移动到空白处。如上表中的点击选中B4的数字“643422358”，再点H15，“643422358”数字就自动填充到H15表格（要求每次只填充一次，数据为唯一性。见效果表格）？附件： 新建文件夹.rar (2.21 KB, 下载次数: 18)

2018-9-13 20:50 上传

点击文件名下载附件

ww87725244

1. Option Explicit
   
2. Dim s, add, add1
   
3. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
4. If Target.Value = "" Then
   
5.     add1 = Target.Address
   
6.     If add1 <> add Then
   
7.         Target.Value = s
   
8.         Range(add).Value = ""
   
9.     Else
   
10.         MsgBox "你点击了同一单元格"
    
11.         Exit Sub
    
12.     End If
    
13. Else
    
14.     s = Target.Value
    
15.     add = Target.Address
    
16. End If
    
17. End Sub

复制代码

gzhdclc

ww87725244 发表于 2018-9-13 21:40

谢谢老师，非常感谢老师。这段代码基本实现效果，不足就是一次复制可以填充多个单元格，我希望一个数据只能填充一次，因为数据是唯一的。

gzhdclc

2楼代码一次点击选中后可在空白处连续多次填充，不符合表格数据唯一性要求，各位老师，请教如何加限制代码？

蓝桥玄霜

第4行前面加一句：
If Target.Count > 1 Then Exit Sub

gzhdclc

蓝桥玄霜 发表于 2018-9-15 09:44
第4行前面加一句：
If Target.Count > 1 Then Exit Sub

蓝老师，用您提供的方法，结果还是一样（还是和原来一样可以多次填充），请问我加的地方是不是不对？

Option Explicit
Dim s, add, add1
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Value = "" Then
    add1 = Target.Address
    If add1 <> add Then
        Target.Value = s
        Range(add).Value = ""
    Else
        MsgBox "你点击了同一单元格"
        Exit Sub
    End If
Else
    s = Target.Value
    add = Target.Address
End If
End Sub

ww87725244

gzhdclc 发表于 2018-9-13 21:51
谢谢老师，非常感谢老师。这段代码基本实现效果，不足就是一次复制可以填充多个单元格，我希望一个数据只 ...

改了一下

1. Option Explicit
   
2. Dim s, add
   
3. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
4. If Target.Count > 1 Then Exit Sub
   
5. If Target.Value = "" Then
   
6.     Target.Value = s
   
7.     If add = "" Then
   
8.         Exit Sub
   
9.     Else
   
10.         Range(add).Value = ""
    
11.     End If
    
12.     s = ""
    
13. Else
    
14.     s = Target.Value
    
15.     add = Target.Address
    
16. End If
    
17. End Sub
    

复制代码

gzhdclc

ww87725244 发表于 2018-9-16 22:32
改了一下

谢谢老师。非常感谢老师的帮助。我还想请教一个问题，如限制只有B4：K11区域数据可以移动，请问如何加代码，谢谢？

lsc900707

gzhdclc 发表于 2018-9-16 23:01
谢谢老师。非常感谢老师的帮助。我还想请教一个问题，如限制只有B4：K11区域数据可以移动，请问如何加代 ...

1. Option Explicit
   
2. Dim s, add
   
3. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
4.     If Target.Count > 1 Then Exit Sub
   
5.     If Target.Row > 3 And Target.Row < 12 And Target.Column > 1 And Target.Column < 12 Then
   
6.         If Target.Value = "" Then
   
7.             Target.Value = s
   
8.             If add = "" Then
   
9.                 Exit Sub
   
10.             Else
    
11.                 Range(add).Value = ""
    
12.             End If
    
13.             s = ""
    
14.         Else
    
15.             s = Target.Value
    
16.             add = Target.Address
    
17.         End If
    
18.     End If
    
19. End Sub

复制代码

gzhdclc

lsc900707 发表于 2018-9-17 05:33

谢谢版主，非常感谢。