选中单元格循环写入

shenzhenyang

1. Sub 粘贴号()
   
2. 
   
3. Application.ScreenUpdating = False
   
4. 
   
5. Dim rng As Range, a
   
6. 
   
7. a = ActiveCell.Row
   
8. 
   
9. rngg = .Range("g1")
   
10. 
    
11.     For Each rng In Selection
    
12. 
    
13.         If Cells(a, 7) = "" And Cells(a, 8) <> "" Then
    
14. 
    
15.             Selection.NumberFormatLocal = "@"
    
16. 
    
17.             rng = "0" & rngg + 1
    
18. 
    
19.         End If
    
20. 
    
21.     Next
    
22. 
    
23. Application.ScreenUpdating = True
    
24. 
    
25. 
    
26. End Sub

复制代码

灰色区域效果，
在论坛抄写的代码，不会循环写入选择的单元格。

1.首先按我用鼠标选中G列单元才循环写入号码。没有选到的单元格不能写入。
G列写入的单元格不是固定，根据鼠标选中单元格。
比如我用鼠标选中的G4：G12的单元格，那么H列单元格不为空和G列单元格是空就写入号码

谢谢老师帮忙。

shenzhenyang

麻烦老师帮我看下，怎么才能循环，现在选中单元格只能写入第一个就停止了，不会继续往下写入。

bqwd36

不是循环的问题吧，好像是你的a固定了是选择的范围的第一个单元格所在行啊

shenzhenyang

bqwd36 发表于 2023-3-24 17:02
不是循环的问题吧，好像是你的a固定了是选择的范围的第一个单元格所在行啊

但是如果我一个一个单元格选中符合条件（G4,G6,G7,G8,G10），要可以一次性写入号码

zjzyj

供参考      

准提部林

要做什麼???不清楚

For Each rng In Selection
    If rng = "" And Cells(rng.Row, "h") <> "" Then
       rng.NumberFormatLocal = "@"
       rng = "0" & rngg + 1
    End If
Next

gwjkkkkk

Sub test()
   Dim Rng As Range, rngCel As Range
   
   Set Rng = Intersect(Columns("G"), Selection)
   If Not Rng Is Nothing Then
        For Each rngCel In Rng
            If rngCel.Offset(, 1) <> "" Then
               rngCel.NumberFormatLocal = "@"
               rngCel = "0" & [G1]
            End If
        Next
   End If
End Sub

gwjkkkkk

参与一下。。。

shenzhenyang

准提部林 发表于 2023-3-24 20:28
要做什麼???不清楚

For Each rng In Selection

谢谢老师，我是明细账，选择部分数据粘贴单号，生产出库单。G1是最后一个单号，新的单号是在最后一个单号加1。

xiaoya6976

不知道符合你的意思不，才开始学习VBA，献丑；用Worksheet_SelectionChange事件来写感觉比SUB过程要方便点，直接在G列框选就可以填入号码

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.    
   
3.     Dim i, j, rw
   
4.     If Err.Number > 0 Then
   
5.         If Target.Column = 7 And Target.Offset(0, 1).Value <> "" Then
   
6.             Target.Value = "号码"
   
7.         End If
   
8.     Else
   
9.         If Target.Column = 7 Then
   
10.             On Error Resume Next '忽略错误继续执行VBA代码,避免出现错误消息
    
11.             i = Selection.Rows(Selection.Rows.Count).Row
    
12.             j = Selection.Cells(1).Row
    
13.             For rw = j To i
    
14.                 If Cells(rw, 7).Offset(0, 1) <> "" Then
    
15.                     Cells(rw, 7).Value = "号码"
    
16.                 Else
    
17.                     Cells(rw, 7).Value = ""
    
18.                 End If
    
19.             Next
    
20.         End If
    
21.     End If
    
22. End Sub

复制代码