如何用VBA隔行填色 同时粘贴数据进去

梦远方

求助大神，如何用VBA隔行填色 同时粘贴数据进去，我写了个代码  但是显示子函数或数据成员未找到

不知道为什么

看不明白到底需要输出一个什么样的结果，自己可以录制宏来解决

sa3131

可参考工资表表头快速制作

梦远方

不知道为什么 发表于 2018-8-14 16:51
看不明白到底需要输出一个什么样的结果，自己可以录制宏来解决

您看下我上传的附件，就会明白的

梦远方

朱荣兴 发表于 2018-8-15 07:29
看了半天附件，说明文字看不懂，模拟结果更看不懂，

当表7里面有几个名字  那么就在表一每行下面插入名字的行数，并将表7 的名字复制到表1，重复复制。我有一份清单，想要清单的每列数据前面，出现表7每一个人的名字， 真的很着急要完成的工作 【哭 哭】

xiangbaoan

'猜测的，不对的话那是没懂的你意思。

Sub 隔行插入()
Application.ScreenUpdating = False
Dim rng As Range, r&
Set rng = Sheets("sheet7").[c4:c13] '10
With Sheets("sheet1")
    For r = .[c65536].End(3).Row To 2 Step -1
        Rows(r + 1 & ":" & r + 9).Insert Shift:=xlDown
        rng.Copy .Cells(r, 2)
    Next
End With
Application.ScreenUpdating = True
End Sub

xiangbaoan

…………附件仅供测试……

梦远方

xiangbaoan 发表于 2018-8-15 09:13
'猜测的，不对的话那是没懂的你意思。

Sub 隔行插入()

赞，就是要实现这样的效果，但是由于工作的原因，表7的名字数会不断的变化，所以要插入的行数也会有变化，应该怎么改代码呢？  另外 For r = .[c65536].End(3) 这句代码的意思是什么？


Sub 隔行插入()
Application.ScreenUpdating = False
Dim rng As Range, r&, tx As Integer
tx = Application.Worksheetsfunction.CountA(Range("C:C"))
Set rng = Sheets("sheet7").[c4:c&"tx"]
With Sheets("sheet1")
    For r = .[c65536].End(3).Row To 2 Step -1
        Rows(r + 1 & ":" & r + tx - 1).Insert Shift:=xlDown
        rng.Copy .Cells(r, 2)
    Next
End With
Application.ScreenUpdating = True
End Sub


改成这样  运行显示对象不支持该属性或方法   【哭  哭】

莫名v微笑

1. Sub 测试14()
   
2. Application.ScreenUpdating = False
   
3. arr = Sheets("sheet7").Range("c3:c13")
   
4. k = 3
   
5. o = 10 '要插入几个10行
   
6. For i = 1 To o
   
7. If i = 1 Then
   
8. Rows(k).Resize(10).Insert: Sheets("sheet1").Range("b" & k - 1).Resize(UBound(arr)) = arr
   
9. Else:
   
10. k = k + 11
    
11. Rows(k).Resize(10).Insert: Sheets("sheet1").Range("b" & k - 1).Resize(UBound(arr)) = arr
    
12. End If
    
13. Next
    
14. Application.ScreenUpdating = True
    
15. End Sub
    

复制代码

尝试着写了一个，不清楚是不是你要的。