帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2011-5-25 20:20 | 只看該作者

[發問] 請問如何自動新增工作表，並將名稱改成文字(今天日期)，在貼上某檔案並且不含公式

請問如何利用自動生成新的工作表，並將工作表名稱改為統計值(今天日期)<==例如:統計值(20110525)，如果當天已經有統計過則在日期後面加-1..-2..-3以此類推，例如:統計值(20110525-1)，且將M1到Q12(黃色部分)的表格及值貼上(但是不含公式)，請問此巨集該如何寫?

TEST.rar (8.75 KB)

樓主熱帖

棋語鳥鳴

中學生 Rank: 2

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

10^#

發表於 2011-5-27 22:43 | 只看該作者

回復 8# GBKEE
謝謝您的回覆!雖然這不是我要的答案!但是我卻可以用到另一的是地方，所以還是很謝謝您!

TOP

棋語鳥鳴

中學生 Rank: 2

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

9^#

發表於 2011-5-27 22:40 | 只看該作者

回復 7# Hsieh

沒錯這就是我要的答案，而且2個問題都答了!謝謝您的回覆!想在請問一下!
如果將Q2:T2改成了R1:R4(變成直式的)，那要如何使值轉置(變成橫式的)??檔案如附件!

TEST2-2.rar (19.69 KB)

TOP

GBKEE

超級版主 Rank: 8 Rank: 8

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

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

8^#

發表於 2011-5-27 09:33 | 只看該作者

本帖最後由 GBKEE 於 2011-5-27 09:35 編輯

回復 6# 棋語鳥鳴
不太了解你的意思試看看

全部複製

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range
Set Rng = [A2:A12]
If Not Application.Intersect(Rng, Target(1)) Is Nothing Then
With Sheets("總表").Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Cells(1).Resize(Rng.Rows.Count) = Rng.Value
.Cells(1, 2).Resize(Rng.Rows.Count, 3) = Range("R2").Resize(, 3).Value
End With
End If
End Sub

複製代碼

複製選擇處到底部

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Rng As Range
Set Rng = [A2:A12]
If Not Application.Intersect(Rng, Target(1)) Is Nothing Then
For i = Target(1).Row To Rng.End(xlDown).Row
With Sheets("總表").Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Cells(1) = Cells(i, Target(1).Column)
.Cells(1, 2).Resize(, 3) = Range("R2").Resize(, 3).Value
End With
Next
End If
End Sub

複製代碼

TOP

Hsieh

超級版主 Rank: 8 Rank: 8

帖子: 4901
主題: 44
精華: 24
積分: 4916
點名: 254
作業系統: Windows 7
軟體版本: Office 20xx
閱讀權限: 150
性別: 男
來自: 台北
註冊時間: 2010-4-30
最後登錄: 2024-11-23

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章 2020鼠年全勤獎章 2019 豬年全勤獎章 2018 狗年全勤獎章 2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱心公益勳章 2011兔年全勤獎章

7^#

發表於 2011-5-27 09:29 | 只看該作者

本帖最後由 Hsieh 於 2011-5-27 09:38 編輯

回復 6# 棋語鳥鳴

Sub 圓角矩形2_Click()
Dim Ar()
With Sheet1
Rng = .[Q1:T1].Value
For Each a In .Range("A2:A12")
.[Q2] = a
ReDim Preserve Ar(s)
Ar(s) = Application.Transpose(Application.Transpose(.[Q2:T2]))
s = s + 1
Next
End With
For Each sh In Sheets
If sh.Name Like Format(Date, "yyyymmdd") & "*" Then k = k + 1
Next
k = IIf(k = 0, "", "_" & CStr(k))
With Sheets.Add
.Name = Format(Date, "yyyymmdd" & k)
.[A1:D1].Value = Rng
.[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
End With
End Sub

複製代碼

學海無涯_不恥下問

TOP

棋語鳥鳴

中學生 Rank: 2

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

6^#

發表於 2011-5-27 08:00 | 只看該作者

本帖最後由棋語鳥鳴於 2011-5-27 08:03 編輯

回復 5# GBKEE

這個我知道!我想問說!如果想讓他"自動連續點擊"
                                                   A2
                                                   A3
                                                   A4
                                                   A5.....一直到A12
就像:Range("A2").Select
   Range("A3").Select
               .
               .
               .
               .
   依直到Range("A12").Select
要怎麼改寫進去~或者簡化??

TOP

GBKEE