[已解决]爱疯 老师 请帮忙！！求写一个流水抽奖券， 的程序 有附件 在线等

kidd1217

各位你们好

   希望按照附件的里格式 写个抽奖券， 编号一直到500 就行

我现在的表格只有小部分，希望有个程序继续复制下去，一直复制到编号到500 就行

谢谢

最佳答案

月排行榜 / 总排行榜

爱疯

2014-1-13 15:23

Sub Click()
    Dim A$(1 To 180, 1 To 6), i%, j%, s%, str$

    str = "赛维抽奖券"
    For i = 1 To UBound(A)
        For j = 1 To UBound(A, 2)
            If i Mod 2 Then
                A(i, j) = str
            Else
                s = s + 1
                A(i, j) = Format(s, "000")
            End If
        Next j
    Next i

    With Sheet2
        .Cells.Clear
        .Range("a1").Resize(i - 1, j - 1) = A
        .Activate
    End With
End Sub

赛维抽奖券2.rar (619.07 KB, 下载次数: 27)

2014-1-13 15:23 上传

点击文件名下载附件

跳转到最佳答案楼层

kidd1217

没人帮西下吗？！！急救

爱疯

Sub Click()
    Dim A$(1 To 180, 1 To 6), i%, j%, s%, str$

    str = "赛维抽奖券"
    For i = 1 To UBound(A)
        For j = 1 To UBound(A, 2)
            If i Mod 2 Then
                A(i, j) = str
            Else
                s = s + 1
                A(i, j) = Format(s, "000")
            End If
        Next j
    Next i

    With Sheet2
        .Cells.Clear
        .Range("a1").Resize(i - 1, j - 1) = A
        .Activate
    End With
End Sub

赛维抽奖券2.rar (619.07 KB, 下载次数: 27)

2014-1-13 15:23 上传

点击文件名下载附件

ccentaurc2005

学习一下！！！{:3512:}