返回列表 上一主題 發帖

[發問] 以控制項Nrange填入的起迄期數產生效果檔案。

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
1# 跳轉到 »
發表於 2019-3-8 17:46 | 顯示全部帖子
回復 2# papaya
  1. Private Sub CommandButton1_Click()
  2.     Dim text As String, istart As Integer, iend As Integer
  3.     Dim file As String, ar
  4.     text = InputBox("請輸入期數, (如: 1000,1010-1020)", "產生排序檔")
  5.     If Len(text) = 0 Then MsgBox "Bad Input": Exit Sub
  6.     Application.DisplayAlerts = False
  7.     Application.ScreenUpdating = False
  8.     For Each s In Split(text, ",")
  9.         file = ThisWorkbook.Path & "\排序" & Trim(s) & ".xls"
  10.         ar = Split(Trim(s), "-")
  11.         istart = CInt(ar(0))
  12.         If UBound(ar) = 0 Then
  13.             iend = istart
  14.         Else
  15.             iend = CInt(ar(1))
  16.         End If
  17.         
  18.         If Len(Dir(file)) > 0 Then Kill file
  19.         Set wb = Workbooks.Add()
  20.         With wb
  21.             For i = .Sheets.Count To 2 Step -1: .Sheets(i).Delete: Next
  22.             With .Sheets(1)
  23.                 .Name = "總表"
  24.                 ThisWorkbook.Sheets("DATA").[A:J].Copy .[A1]
  25.                 .Activate
  26.                 .[B2].Select
  27.                 ActiveWindow.FreezePanes = True
  28.             End With
  29.             .Sheets.Add After:=.Sheets(1), Count:=iend - istart + 1
  30.             For i = 0 To iend - istart
  31.                 With .Sheets(i + 2)
  32.                     .Name = "排序" & istart + i
  33.                     .[A1].Value = istart + i
  34.                     .[A1].Font.Bold = True
  35.                     .[A1].Interior.Color = 52479
  36.                     .Activate
  37.                     .[B2].Select
  38.                     ActiveWindow.FreezePanes = True
  39.                 End With
  40.             Next
  41.             .Sheets(1).Activate
  42.             .SaveAs Filename:=file, FileFormat:=xlWorkbookNormal
  43.             .Close False
  44.         End With
  45.     Next
  46.     Application.ScreenUpdating = True
  47.     Application.DisplayAlerts = True
  48.     MsgBox "Finish"
  49. End Sub
複製代碼
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 話多不如話少，話少不如話好。
返回列表 上一主題