Board logo

標題: [發問] 請問如何自動新增工作表，並將名稱改成文字(今天日期)，在貼上某檔案並且不含公式 [打印本頁]
作者: 棋語鳥鳴    時間: 2011-5-25 20:20     標題: 請問如何自動新增工作表，並將名稱改成文字(今天日期)，在貼上某檔案並且不含公式

請問如何利用自動生成新的工作表，並將工作表名稱改為統計值(今天日期)<==例如:統計值(20110525)，如果當天已經有統計過則在日期後面加-1..-2..-3以此類推，例如:統計值(20110525-1)，且將M1到Q12(黃色部分)的表格及值貼上(但是不含公式)，請問此巨集該如何寫?[attach]6335[/attach]
作者: 棋語鳥鳴    時間: 2011-5-25 20:41     標題: 請問如何讓滑鼠點擊A1後，複製R2~T2，製另一個工作表貼上?

請問如何利用自動點擊A1~A12，並將R2~T2的值貼到總表上(不加公式)，請問此巨集該如何寫?程序:點擊A1-->複製R2~T2-->貼製總表B1~D1，:
點擊A2-->複製R2~T2-->貼製總表B2~D2……依直到點擊A12-->複製R2~T2-->貼製總表B12~D12
[attach]6336[/attach]
作者: GBKEE    時間: 2011-5-25 21:11

本帖最後由 GBKEE 於 2011-5-25 21:36 編輯

回復 2# 棋語鳥鳴
Sheets("統計值")的程式碼
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     If Not Application.Intersect([A2:A12], Target(1)) Is Nothing Then
  3.         With Sheets("總表").Cells(Rows.Count, "A").End(xlUp).Offset(1)
  4.             .Cells(1) = Target(1)
  5.             .Cells(1, 2).Resize(, 3) = Range("R2").Resize(, 3).Value
  6.         End With
  7.     End If
  8. End Sub
複製代碼
作者: 棋語鳥鳴    時間: 2011-5-26 20:16

本帖最後由 棋語鳥鳴 於 2011-5-26 20:19 編輯

回復 3# GBKEE


謝謝妳ㄉ回覆~我了解了!!
請問要更如更改成，自動點擊A2~A12呢?
作者: GBKEE    時間: 2011-5-26 20:29

回復 4# 棋語鳥鳴
Worksheet_SelectionChange   就是工作表預設事件程式  (滑鼠左鍵點擊一次)
作者: 棋語鳥鳴    時間: 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
要怎麼改寫進去~或者簡化??
作者: Hsieh    時間: 2011-5-27 09:29

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

回復 6# 棋語鳥鳴
  1. Sub 圓角矩形2_Click()
  2. Dim Ar()
  3. With Sheet1
  4. Rng = .[Q1:T1].Value
  5. For Each a In .Range("A2:A12")
  6. .[Q2] = a
  7. ReDim Preserve Ar(s)
  8. Ar(s) = Application.Transpose(Application.Transpose(.[Q2:T2]))
  9. s = s + 1
  10. Next
  11. End With
  12. For Each sh In Sheets
  13.   If sh.Name Like Format(Date, "yyyymmdd") & "*" Then k = k + 1
  14. Next
  15. k = IIf(k = 0, "", "_" & CStr(k))
  16. With Sheets.Add
  17. .Name = Format(Date, "yyyymmdd" & k)
  18. .[A1:D1].Value = Rng
  19. .[A2].Resize(s, 4) = Application.Transpose(Application.Transpose(Ar))
  20. End With
  21. End Sub
複製代碼
作者: GBKEE    時間: 2011-5-27 09:33

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

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

全部複製
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim Rng As Range
  3.     Set Rng = [A2:A12]
  4.     If Not Application.Intersect(Rng, Target(1)) Is Nothing Then
  5.         With Sheets("總表").Cells(Rows.Count, "A").End(xlUp).Offset(1)
  6.             .Cells(1).Resize(Rng.Rows.Count) = Rng.Value
  7.             .Cells(1, 2).Resize(Rng.Rows.Count, 3) = Range("R2").Resize(, 3).Value
  8.         End With
  9.     End If
  10. End Sub
複製代碼
複製 選擇處到底部
  1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  2.     Dim Rng As Range
  3.     Set Rng = [A2:A12]
  4.     If Not Application.Intersect(Rng, Target(1)) Is Nothing Then
  5.         For i = Target(1).Row To Rng.End(xlDown).Row
  6.             With Sheets("總表").Cells(Rows.Count, "A").End(xlUp).Offset(1)
  7.                 .Cells(1) = Cells(i, Target(1).Column)
  8.                 .Cells(1, 2).Resize(, 3) = Range("R2").Resize(, 3).Value
  9.             End With
  10.         Next
  11.     End If
  12. End Sub
複製代碼
作者: 棋語鳥鳴    時間: 2011-5-27 22:40

回復 7# Hsieh


    沒錯這就是我要的答案，而且2個問題都答了!謝謝您的回覆!想在請問一下!
如果將Q2:T2改成了R1:R4(變成直式的)，那要如何使值轉置(變成橫式的)??檔案如附件![attach]6373[/attach]
作者: 棋語鳥鳴    時間: 2011-5-27 22:43

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



歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)