返回列表 上一主題 發帖

[發問] 製作簽到簿卡住了.......

[發問] 製作簽到簿卡住了.......

製作簽到簿卡住了,請前輩幫忙,我只會把第一張版面設定好,往下的版面如何處理,謝謝.

123.rar (43.07 KB)

杜小平

回復 1# dou10801

請測試看看,謝謝。

Sub test()
Dim Arr, Ar(1 To 27, 1 To 3), R%, C%, i&
Application.ScreenUpdating = False
Ar(1, 1) = "編 號": Ar(1, 2) = "姓 名": Ar(1, 3) = "簽 章"
R = 3: C = 5: N = 1
Arr = Range([會員資料!A1], [會員資料!B65536].End(3))
For i = 1 To UBound(Arr)
    N = N + 1: Ar(N, 1) = Arr(i, 1): Ar(N, 2) = Arr(i, 2)
    If N = 26 Then
        With Sheets("會員簽到簿").Cells(R, C).Resize(N, 3)
            .Value = Ar
            .Borders.LineStyle = xlContinuous
        End With
        C = C + 4: N = 1
    End If
    If C > 13 Then C = 5: R = R + 28
Next
If N > 1 Then
    With Sheets("會員簽到簿").Cells(R, C).Resize(N, 3)
        .Value = Ar
        .Borders.LineStyle = xlContinuous
    End With
End If
Application.ScreenUpdating = True
End Sub

TOP

回復 2# samwang 感謝 samwang 前輩回覆,如何調整一頁是1-100,第二頁101-200....的頁面,如何設定為A3版面,橫向,感恩.
簽到簿.jpg
杜小平

TOP

回復 4# dou10801
簽到簿1.jpg
杜小平

TOP

回復 3# dou10801

如何調整一頁是1-100,第二頁101-200....的頁面>> 如下,請試看看,謝謝

Sub test2()
Dim Arr, Ar(1 To 27, 1 To 3), R%, C%, i&
Application.ScreenUpdating = False
Ar(1, 1) = "編 號": Ar(1, 2) = "姓 名": Ar(1, 3) = "簽 章"
R = 3: C = 5: N = 1
Arr = Range([會員資料!A1], [會員資料!B65536].End(3))
For i = 1 To UBound(Arr)
    N = N + 1: Ar(N, 1) = Arr(i, 1): Ar(N, 2) = Arr(i, 2)
    If N = 26 Then
        With Sheets("會員簽到簿").Cells(R, C).Resize(N, 3)
            .Value = Ar
            .Borders.LineStyle = xlContinuous
        End With
        C = C + 4: N = 1
    End If
    If C > 17 Then C = 5: R = R + 28  'C:填入資料位置(換頁),可自行調整
Next
If N > 1 Then
    With Sheets("會員簽到簿").Cells(R, C).Resize(N, 3)
        .Value = Ar
        .Borders.LineStyle = xlContinuous
    End With
End If
Application.ScreenUpdating = True
End Sub

TOP

回復 5# samwang 感謝,感謝.VBA版面自行修飾.
杜小平

TOP

回復 1# dou10801

試試看
Sub ex()
Dim x%, y%, z%
For x = 1 To Sheets("會員資料").[a65535].End(3).Row Step 25
   With Sheets("會員簽到簿1")
      .[a3].Offset(y, z).Resize(, 3) = Array("編 號", " 姓名", "簽章")
      Cells(x, 1).Resize(25, 3).Copy .[a4].Offset(y, z)
      With .[a3].Offset(y, z).CurrentRegion
         .Borders.LineStyle = xlContinuous
      End With
      z = z + 4
      If z = 16 Then z = 0: y = y + 28
   End With
Next
End Sub

TOP

回復 7# jcchiang 感恩,另一種思路,學習,學習.
杜小平

TOP

回復 7# jcchiang 請教 jcchiang 大大,如何將空隔填滿,謝謝.
簽到簿3.jpg
2021-4-27 10:06
杜小平

TOP

回復 7# jcchiang
簽到簿3-1.jpg
2021-4-27 10:08
杜小平

TOP

        靜思自在 : 謊言像一朵盛開的鮮花,外表美麗,生命短暫。
返回列表 上一主題