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

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

12^#

發表於 2021-4-27 18:41 | 只看該作者

回復 11# dou10801

Sub ex()
Dim x%, y%, z%
For x = 1 To WorksheetFunction.RoundUp(Sheets("會員資料").[a65535].End(3).Row / 100, 0) * 100 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).Resize(26, 3)
      .Borders.LineStyle = xlContinuous
   End With
   z = z + 4
   If z = 16 Then z = 0: y = y + 28
End With
Next
End Sub

帖子: 146
主題: 41
精華: 0
積分: 229
點名: 289
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

11^#

發表於 2021-4-27 14:07 | 只看該作者

回復 7# jcchiang 每頁剛好1-100,第二頁101-200....以此類推,本範例到443筆,畫空格線到500,剛好一頁,謝謝.

杜小平

帖子: 146
主題: 41
精華: 0
積分: 229
點名: 289
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

10^#

發表於 2021-4-27 10:08 | 只看該作者

回復 7# jcchiang

杜小平

帖子: 146
主題: 41
精華: 0
積分: 229
點名: 289
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

9^#

發表於 2021-4-27 10:08 | 只看該作者

回復 7# jcchiang 請教 jcchiang 大大,如何將空隔填滿,謝謝.

杜小平

帖子: 146
主題: 41
精華: 0
積分: 229
點名: 289
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

8^#

發表於 2021-4-26 07:56 | 只看該作者

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

杜小平

jcchiang

帖子: 234
主題: 19
精華: 0
積分: 276
點名: 0
作業系統: Windows XP
軟體版本: office 2003
閱讀權限: 20
性別: 男
註冊時間: 2013-1-7
最後登錄: 2021-10-7

7^#

發表於 2021-4-23 21:04 | 只看該作者

回復 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

帖子: 146
主題: 41
精華: 0
積分: 229
點名: 289
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

6^#

發表於 2021-4-23 16:05 | 只看該作者

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

杜小平

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-10-30

5^#

發表於 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

帖子: 146
主題: 41
精華: 0
積分: 229
點名: 289
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

4^#

發表於 2021-4-23 14:40 | 只看該作者

回復 4# dou10801

簽到簿1.jpg (158.14 KB)

杜小平