返回列表 上一主題 發帖

[發問] 工作表選取 VBA語法

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2019-5-23 08:11 | 顯示全部帖子
試試看
  1. Option Explicit
  2. Sub EX() '**1. 從Sheets("2")的工作表名稱(不是從第2個工作表開始數),一直到最後一個工作表選取起來
  3.     Dim Sh As Worksheet, Ar, M As String
  4.     For Each Sh In Sheets
  5.         If Sh.Name = "2" Then
  6.             M = Sh.Name
  7.         ElseIf M <> "" Then
  8.             M = M & "," & Sh.Name
  9.         End If
  10.         '**Range(B2:C3)值化(讓公式變成值)
  11.         If M <> "" Then Sh.Range("B2:C3") = Sh.Range("B2:C3").Value
  12.     Next
  13.     Ar = Split(M, ",")
  14.     Sheets(Ar).Select
  15. End Sub

  17. Sub EX1() '**2. 從Sheets("2")開始至Sheet("總表")結束,之間的起迄範圍工作表選取起來
  18.     Dim Sh As Worksheet, Ar, M As String
  19.     For Each Sh In Sheets
  20.         If Sh.Name = "2" Then
  21.             M = Sh.Name
  22.         ElseIf M <> "" Then
  23.             M = M & "," & Sh.Name
  24.         End If
  25.         '**Range(B2:C3)值化(讓公式變成值)
  26.         If M <> "" Then Sh.Range("B2:C3") = Sh.Range("B2:C3").Value
  27.         If Sh.Name = "總表" Then Exit For
  28.     Next
  29.     Ar = Split(M, ",")
  30.     Sheets(Ar).Select
  31. End Sub
複製代碼
回復 1# PJChen
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2019-5-27 09:07 | 顯示全部帖子
回復 3# PJChen


試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Sh As Worksheet, xday(1 To 2) As Integer, Msg As Boolean, Ar
  4.     xday(1) = 4            '**指定開始日
  5.     xday(2) = Day(DateSerial(Year(Date), Month(Date) + 1, 0))  '**月底日
  6.     Application.DisplayAlerts = False
  7.     For Each Sh In Sheets
  8.         Msg = True
  9.         If IsNumeric(Sh.Name) And Val(Sh.Name) > xday(2) Then
  10.             Msg = False
  11.             Sh.Delete
  12.         ElseIf IsNumeric(Sh.Name) And Val(Sh.Name) < xday(1) Then
  13.             Msg = False
  14.         End If
  15.         If Msg Then Ar = Ar & "," & Sh.Name: Sh.[B2] = Sh.[B2].Value
  16.     Next
  17.     Ar = Split(Mid(Ar, 2), ",")
  18.     Sheets(Ar).Select
  19.     Application.DisplayAlerts = True
  20. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 【停滯不前，終無所得】人都迷於尋找奇蹟，因而停滯不前；縱使時間再多、路再長，也了無用處，終無所得。
返回列表 上一主題