[發問] 關於不固定欄 自動列印至最後一筆資料

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

13^#

發表於 2016-4-27 21:08 | 只看該作者

回復 12# lpk187

謝謝幫忙~完美運行！

lpk187

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

12^#

發表於 2016-4-26 22:17 | 只看該作者

回復 11# starry1314

Option Explicit

Sub 巨集1()
Dim c As Range, firstAddress$, myColumn%
With Sheets("工作表1")
      Set c = .Rows(3).Find("P.P", LookIn:=xlValues) '尋求第一個目標物件
         If Not c Is Nothing Then '如果c物件不是為Nothing時，執行
            firstAddress = c.Address '記錄找到的第一個位置
            myColumn = 1 '設定A欄
            Do
                  '.Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area" '
                  .Range(.Cells(Rows.Count, myColumn).End(xlUp), Cells(2, c.Column)).Name = "Print_Area" '設定列印範圍，以設定範圍來說，例如："A1:C5"和"A5:C1"是一樣的意思
                  '只不過A欄可以找到最後一列，所以要用後者來設定範圍
                  .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False '列印
                  Set c = .Rows(3).FindNext(c) '尋找下一個目標物
                  myColumn = myColumn + 19 '下一個個位置為T欄...再來是AM欄，依此類推
            Loop While Not c Is Nothing And c.Address <> firstAddress '當c的位址和第一個位址相同時，跳出迴圈
         End If
End With
End Sub

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

11^#

發表於 2016-4-26 21:25 | 只看該作者

回復 9# lpk187

不好意思..有點卡關新的程式碼

會選擇所有列,另外用變數計算列後再放入會變只選取最上面兩列
Sub 巨集()
Dim c As Range, firstAddress$, myColumn%
With Sheets("工作表1")
      Set c = .Rows(3).Find("P.P", LookIn:=xlValues)
         If Not c Is Nothing Then
            firstAddress = c.Address
            myColumn = 1
            Do
                  .Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area"
                  .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
                  Set c = .Rows(3).FindNext(c)
                  myColumn = myColumn + 19
            Loop While Not c Is Nothing And c.Address <> firstAddress
         End If
End With
End Sub

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

10^#

發表於 2016-4-26 20:58 | 只看該作者

回復 starry1314

在此先感謝准提部林大大教授的"rint_Area"語法

利用Range.Find說明範例修改一 ...
lpk187 發表於 2016-4-26 20:38

感謝...要研究一下比上一個複雜了....

lpk187

帖子: 552
主題: 3
精華: 0
積分: 578
點名: 0
作業系統: win7
軟體版本: office 2010
閱讀權限: 50
性別: 男
註冊時間: 2015-2-8
最後登錄: 2024-7-9

2016猴年全勤獎章 2015羊年全勤獎章熱烈參與勳章

9^#

發表於 2016-4-26 20:38 | 只看該作者

本帖最後由 lpk187 於 2016-4-26 20:42 編輯

回復 8# starry1314

在此先感謝准提部林大大教授的"Print_Area"語法

利用Range.Find說明範例修改一下，可以達到你的要求，就是再利用FindNext

Sub 巨集1()
Dim c As Range, firstAddress$, myColumn%
With Sheets("工作表1")
Set c = .Rows(3).Find("P.P", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
myColumn = 1
Do
.Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area"
.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
Set c = .Rows(3).FindNext(c)
myColumn = myColumn + 19
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub

複製代碼

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

8^#

發表於 2016-4-26 12:45 | 只看該作者

回復 3# lpk187
回復 6#

Set c = .Rows(3).Find("P.P", , , , , 1) '往後尋找
想請問能否不要往前往後可選擇找到的第幾個目前遇到同一張有三張表,

目前只能先將後兩個表的P.P做點改變

　暱稱: 豪

帖子: 471
主題: 121
精華: 0
積分: 579
點名: 0
作業系統: WIN10
軟體版本: OFFICE2019
閱讀權限: 50
性別: 男
註冊時間: 2015-4-16
最後登錄: 2023-1-17

7^#

發表於 2016-4-26 12:25 | 只看該作者

如果只是設定列印範圍,
.PageSetup.PrintArea = "$A$2:" & .Cells(Rows.Count, c.Column).End(xlUp).Addre ...
准提部林發表於 2016-4-26 11:43

感謝教學！！

版主 Rank: 7 Rank: 7 Rank: 7

准提部林

帖子: 2834
主題: 10
精華: 0
積分: 2890
點名: 0
作業系統: 〔略〕
軟體版本: 〔略〕
閱讀權限: 100
性別: 男
來自: 〔略〕
註冊時間: 2013-5-13
最後登錄: 2024-11-23

6^#

發表於 2016-4-26 11:43 | 只看該作者

如果只是設定列印範圍,
.PageSetup.PrintArea = "$A$2:" & .Cells(Rows.Count, c.Column).End(xlUp).Address
也可用:
Range(.[A2], .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area"

相對速度較快!!!