怎么做字帖

hlxue

学习了，谢谢！

gwjkkkkk

125675117 发表于 2024-1-26 09:11
清风老师，想再升个级，能不能定义一下每个字重复次数呢，比如定义每个字重复6次，相当于一行练习两个字

Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, r&, iTimes&
   
    iTimes = Application.InputBox("请选择随机行数", Title:="提示", Default:=6, Type:=1)
    If iTimes = 0 Then Exit Sub
   
    Application.ScreenUpdating = False
    With Sheets(1)
        ar = Range(.[A1], .Cells(Rows.Count, "A").End(xlUp)).Value
        ReDim br(1 To UBound(ar) * iTimes)
        For i = 1 To UBound(ar)
            For j = 1 To iTimes
                r = r + 1
                br(r) = ar(i, 1)
            Next j
        Next i
    End With
    ar = oneToTwoDim(br, 12)
    Cells.Delete
    With [A1].Resize(UBound(ar), UBound(ar, 2))
        .Value = ar
        With .Font
            .Name = "楷体"
            .Size = 39
            .Bold = True
            .ThemeColor = 3
        End With
    End With
    Application.ScreenUpdating = True
    Beep
End Sub
Function oneToTwoDim(ByVal ar, ByVal iColSize&)
    Dim vResult, i&, y&, x&, iRowSize&
   
    iRowSize& = -Int(-UBound(ar) / iColSize)
    ReDim vResult(1 To iRowSize, 1 To iColSize)
    For i = 1 To UBound(ar)
        y = -Int(-i / iColSize)
        x = IIf(i Mod iColSize = 0, iColSize, i Mod iColSize)
        vResult(y, x) = ar(i)
    Next i
    oneToTwoDim = vResult
End Function

gwjkkkkk

125675117 发表于 2024-1-26 09:11
清风老师，想再升个级，能不能定义一下每个字重复次数呢，比如定义每个字重复6次，相当于一行练习两个字

参与一下。。。

125675117

02761752696 发表于 2024-1-26 09:34
......

奇怪了 我的2016word估计有问题，只要调整行数和列数，就会回到默认行列（5X4）

125675117

清风竹- 发表于 2024-1-26 10:32
可定义每个字重复次数。最多可重复24次。

非常完美，感谢感谢！！

125675117

gwjkkkkk 发表于 2024-1-26 18:36
Option Explicit
Sub TEST1()
    Dim ar, br, i&, j&, r&, iTimes&

非常完美，感谢感谢！！