返回列表 上一主題 發帖

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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
1# 跳轉到 »
發表於 2021-4-23 13:00 | 顯示全部帖子
回復 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

samwang

帖子
976 
主題
7 
精華
0 
積分
1018 
點名
0  
作業系統
Win10 
軟體版本
Office 2016 
閱讀權限
50 
性別
男 
註冊時間
2013-4-19 
最後登錄
2026-5-26 
2#
發表於 2021-4-23 14:59 | 顯示全部帖子
回復 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

        靜思自在 : 做好事不能少我一人，做壞事不能多我一人。
返回列表 上一主題