准提部林

回復 9# edmondsforum

編號限定 1 ~ 99
更正檔:
Xl0000176.rar (23.88 KB)

下載次數: 5

2020-8-4 16:44

准提部林

用字典帶入編號:
Xl0000176-1.rar (23.13 KB)

下載次數: 10

2020-8-4 16:53

軒云熊

以下是試著練習的結果 程式很攏長 請大大們指點一下看看有沒有地方不適合這樣的寫法
請告知小弟  請問如果要設定列印分頁的頁數範圍 該如何寫呢? 請大大們幫幫忙

1. Sub 測試練習()
   
2.     Application.ScreenUpdating = False
   
3. 
   
4.     Dim A()
   
5.     For I = 2 To Sheets.Count
   
6.         ReDim Preserve A(I - 1)
   
7.         A(I - 1) = Sheets(I).Cells(2, 2)
   
8.     Next I
   
9.    
   
10.     G = Application.Max(A)
    
11. 
    
12.     ActiveWorkbook.Save
    
13.     For k = 1 To G
    
14.         For I = 2 To Sheets.Count
    
15.             Sheets(I).Select
    
16.             If Format(Sheets(I).Cells(2, 2), "[DBNum1]0") = Format(k, "[DBNum1]0") Then
    
17.                 If Sheets(1).Cells(6, 2) = "" Then
    
18.                     Sheets(I).Range(Cells(1, 1).SpecialCells(xlCellTypeConstants), Sheets(I).Cells(1, 1).SpecialCells(xlCellTypeLastCell)).Copy Sheets(1).Cells(6, 2)
    
19.                 ElseIf Sheets(1).Cells(6, 2) <> "" Then
    
20.                     u = Sheets(1).Cells(1, 1).SpecialCells(xlCellTypeLastCell).Offset(2, 0).Address(0, 0)
    
21.                     Sheets(I).Range(Cells(1, 1).SpecialCells(xlCellTypeConstants), Sheets(I).Cells(1, 1).SpecialCells(xlCellTypeLastCell)).Copy Sheets(1).Cells(Mid(u, 2), 2)
    
22.                 End If
    
23.             End If
    
24.         Next I
    
25.     Next k
    
26.     Sheets(1).Select
    
27.     Range(Cells(1, 1), Cells(1, 1).SpecialCells(xlCellTypeLastCell).Offset(0, 1).Address(0, 0)).Name = "Print_Area"
    
28.    
    
29.     Application.ScreenUpdating = True
    
30. End Sub

複製代碼

edmondsforum

回復 12# 准提部林

謝謝准大，小弟佩服得五體投地啊！
報告准大，小弟有發現你格式原本是使用 [DBNum1]0
因為我想要呈現十 十一 十二 所以我改成  [DBNum1][$-ja-JP]G/通用格式

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖學習到很多知識,以1#範例的學習方案如下,請各位前輩指教

單價分析分表:

下載 (131.18 KB)

2023-12-6 10:32

單價分析總表執行結果:

下載 (120.75 KB)

2023-12-6 10:32

Option Explicit
Sub TEST()
Dim Z, Q, i&, R&, V&, c%, xR As Range, xA As Range, Sh As Worksheet
Set Z = CreateObject("Scripting.Dictionary")
Set Sh = 工作表1: Range(Sh.[A1], Sh.UsedRange).Offset(5).Delete
Set xR = [單價分析總表!B6]
For i = 0 To 10: Z(Right(Application.Text(i, "[DBNum1]"), 1)) = i: Next
For i = 1 To Worksheets.Count
   If Right(Trim(Sheets(i).Name), 5) <> "-單價分析" Then GoTo i01
   Q = Trim(Sheets(i).[B2]) & "○○○"
   For c = 1 To 3: V = Val(V & Z(Mid(Q, c, 1))): Next
   Set Z(V) = Sheets(i): V = 0
i01: Next
For i = 1 To Z.Count
   Q = Application.Small(Z.Keys, i)
   If IsError(Q) Then Exit For
   Set xA = Range(Z(Q).[B2], Z(Q).[G65536].End(3)(1, 2))
   xA.Copy xR
   Set xR = xR.Item(xA.Rows.Count + 2)
Next
With Sh.UsedRange: .Font.ColorIndex = 1: .Value = .Value: End With
Range(Sh.[A1], xR(-1, 8)).Name = "Print_Area"
End Sub