返回列表 上一主題 發帖

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

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

本帖最後由 starry1314 於 2016-4-24 19:32 編輯

請問如何從類別(A2)選擇右手邊第一個P.P位置後往下最後一筆資料,並列印

因欄位不固定且標題會有空白,不過空白格到時會隱藏

在從類別(T2) 往右至P.P欄往下最後一筆資料並列印

原預計使用 MATCH取得P.P所在欄數
但搭配range選擇欄數時會變成選整欄,使用ctrl+shift往上的指令也不會到最後一筆資料,反而手動按確會選擇
自動列印.rar (27.76 KB)

回復 12# lpk187


    謝謝幫忙~完美運行!

TOP

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

TOP

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

TOP

回復  starry1314

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

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


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

TOP

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

回復 8# starry1314

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

    利用Range.Find說明範例修改一下,可以達到你的要求,就是再利用FindNext
  1. Sub 巨集1()
  2.     Dim c As Range, firstAddress$, myColumn%
  3.     With Sheets("工作表1")
  4.         Set c = .Rows(3).Find("P.P", LookIn:=xlValues)
  5.             If Not c Is Nothing Then
  6.                 firstAddress = c.Address
  7.                 myColumn = 1
  8.                 Do
  9.                      .Range(.Cells(2, myColumn), .Cells(Rows.Count, c.Column).End(xlUp)).Name = "Print_Area"
  10.                      .PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
  11.                     Set c = .Rows(3).FindNext(c)
  12.                     myColumn = myColumn + 19
  13.                 Loop While Not c Is Nothing And c.Address <> firstAddress
  14.             End If
  15.     End With
  16. End Sub
複製代碼

TOP

回復 3# lpk187
回復 6#

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

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

TOP

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



    感謝教學!!

TOP

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

相對速度較快!!!

TOP

回復 3# lpk187


    剛改了下用在篩選方面,全自動了....隨標題的改變自己找是第幾欄後再進行篩選後另存
又可以多偷懶了

TOP

        靜思自在 : 看別人不順眼,是自己修養不夠。
返回列表 上一主題