请高手用VBA代码填充数据

hbhsfeng

我参照别人写的代码，填充速度太慢了。请高手帮我写代码，速度快点的，因为数据很多。
见附件。

hbhsfeng

期待高手出现。

xiangbaoan

Sub test()
Application.ScreenUpdating = False
Dim ar, br(), r&, c%
UsedRange.Offset(3, 9).Resize(, 49).ClearContents
ar = Range([c4:i4], [c4:i4].End(4))
ReDim br(1 To UBound(ar), 1 To 49)
For r = 1 To UBound(ar)
    For c = 1 To 6
        br(r, ar(r, c)) = ar(r, c)
    Next
    br(r, ar(r, 7) + 33) = ar(r, 7)
Next
[j4].Resize(r - 1, 49) = br
Application.ScreenUpdating = True
End Sub

hbhsfeng

xiangbaoan 发表于 2018-10-4 13:49
Sub test()
Application.ScreenUpdating = False
Dim ar, br(), r&, c%

我用条件格式设置好的底纹。表格宽度应该可以显示16号Arial字体，为什么填充的时候不能显示出来？只能设置12号Arial字体，我觉得字体有点小，看表格不舒服，如何解决这个问题？

xiangbaoan

hbhsfeng 发表于 2018-10-4 14:24
速度很快，如何设置底纹？把底纹代码能否帮我加上去。

'自己去改数字吧，看哪种颜色你满意
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim ar, br(), r&, c%
With UsedRange.Offset(3, 9).Resize(, 49)
    .ClearContents
    .Interior.Color = xlNone
End With
ar = Range([c4:i4], [c4:i4].End(4))
ReDim br(1 To UBound(ar), 1 To 49)
For r = 1 To UBound(ar)
    For c = 1 To 6
        br(r, ar(r, c)) = ar(r, c)
        Cells(r + 3, ar(r, c) + 9).Interior.ColorIndex = 3
    Next
    br(r, ar(r, 7) + 33) = ar(r, 7)
    Cells(r + 3, ar(r, 7) + 42).Interior.ColorIndex = 15
Next
[j4].Resize(r - 1, 49) = br
Application.ScreenUpdating = True
End Sub

hbhsfeng

xiangbaoan 发表于 2018-10-4 14:46
'自己去改数字吧，看哪种颜色你满意
Private Sub CommandButton1_Click()
Application.ScreenUpdating  ...

太感谢你了。