Board logo

標題: [發問] 如何讓Sheet2=I3，然後又讓該檔名可以繼續變更? [打印本頁]
作者: av8d    時間: 2012-10-15 13:32     標題: 如何讓Sheet2=I3，然後又讓該檔名可以繼續變更?

本帖最後由 av8d 於 2012-10-15 13:59 編輯

Sub aa()
Sheets("Sheet2").Name = [I3]
End Sub


Sheet2檔名則會變成I3，我該如何讓I3繼續變更?
作者: mark15jill    時間: 2012-10-15 13:57

回復 1# av8d


    參考看看

[attach]12773[/attach]
  1. Sub 巨集1()

  3. aois = ActiveSheet.Range("A2").CurrentRegion.Rows.Count
  4.     Sheets("工作表1").Name = "總表"

  6. For gaa = 2 To aois
  7.    
  8.     Sheets.Add After:=Sheets(Sheets.Count)
  9.     Sheets("工作表" & gaa - 1).Select
  10.     Sheets("工作表" & gaa - 1).Name = 工作表1.Cells(gaa, 1)

  12. Next

  14. End Sub
複製代碼
作者: av8d    時間: 2012-10-15 16:24     標題: 如何"自動篩選"+"存到新工作表"

[attach]12778[/attach]

自動篩選第二列會消失~其餘正常~

篩選後~將O欄自動加總於下方~

將第二列到加總列複製貼到~新工作表~工作表名稱=I3

若目前有該工作表則覆蓋貼上~
-----------------------------------------------------
目前只研究出Sheet2命名
Sheets("Sheet2").Name = [I3]
作者: GBKEE    時間: 2012-10-15 18:05

本帖最後由 GBKEE 於 2012-10-16 10:59 編輯

回復 3# av8d
是這樣嗎?
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Car_No As String, xlRow  As Long
  4.     With Sheet1
  5.         .Activate
  6.         .AutoFilterMode = False
  7.         Car_No = InputBox("請輸入車號")
  8.         If Car_No = "" Then MsgBox "沒輸入 車號 ??" & Car_No: Exit Sub
  9.         .Rows(2).Cells(1).AutoFilter Field:=9, Criteria1:=UCase(Car_No)
  10.         xlRow = .Rows(2).Cells(9).End(xlDown).Row
  11.         If xlRow <> Rows.Count Then
  12.             .Cells.SpecialCells(xlCellTypeVisible).Copy
  13.         Else
  14.             MsgBox "找不到 車號 !! " & Car_No:      Exit Sub
  15.         End If
  16.         With Sheets.Add(, Sheets("sheet1"))
  17.             .Paste
  18.             Application.CutCopyMode = False
  19.             .Name = .[i3]
  20.             .[a1].Select
  21.         End With
  22.           '.Rows(xlRow).Delete   '刪一行資料
  23.            'http://forum.twbts.com/viewthread.php?tid=6706&rpid=45209&ordertype=0&page=7#pid45209      
  24.            '提醒修改  刪多行資料
  25.             .Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Offset(2).Delete xlUp
  26.         .AutoFilterMode = False
  27.         .Activate
  28.     End With
  29. End Sub
複製代碼
作者: av8d    時間: 2012-10-16 10:53

回復 4# GBKEE


    [attach]12792[/attach]

套用了一下大大的~想請大大再幫忙一下~謝謝

當資料另存新檔後~Sheet1的資料若有3比~他只會移除1比~是否可以不移除或移除3比

當資料另存新檔後~新資料的金額若要加總該如何做?

我修改了一個~已新增資料表?個~不知道是不是沒寫好~他不會自動增加
作者: c_c_lai    時間: 2012-10-16 11:03

回復 4# GBKEE
我再次重新 DEBUG 一次，結果是：
[attach]12795[/attach]
雖然在實務上我知道要如何處哩，但人活著就是要多多學習，
不熟悉的語法要深切去瞭解，不是嘛？
作者: av8d    時間: 2012-10-16 11:23

回復 6# c_c_lai


    學習了~謝謝大大的提示~我會加倍努力的!
作者: GBKEE    時間: 2012-10-16 13:23

回復 5# av8d
  1. Dim d As Object
  2. Private Sub UserForm_Initialize()
  3.     Dim A As Range
  4.     Set d = CreateObject("Scripting.Dictionary")
  5.     With Sheets("Sheet1")
  6.         .Activate
  7.         For Each A In .Range("I3", .[i3].End(xlDown))
  8.           d(A.Value) = IIf(d(A.Value) = "", A.Offset(, 1).Value, d(A.Value) & "," & A.Offset(, 1))
  9.         Next
  10.         ComboBox1.List = d.keys
  11.     End With
  12.     車號工作表數
  13. End Sub
  14. Private Sub ComboBox1_Change()   ' 復原篩選
  15.     ActiveSheet.AutoFilterMode = False
  16. End Sub
  17. Private Sub CommandButton1_Click() ' 復原篩選
  18.     ctiveSheet.AutoFilterMode = False
  19. End Sub
  20. Private Sub CommandButton2_Click()
  21.     Call Ex
  22.     車號工作表數
  23. End Sub
  24. Private Sub 車號工作表數()
  25.     TextBox1 = Sheets.Count - 1
  26. End Sub
複製代碼
  1. Option Explicit
  2. Sub Ex()
  3.     Dim Car_No As String, xlRow As Long, E As Range, Rng As Range
  4.     With Sheet1
  5.         .Activate
  6.         .AutoFilterMode = False
  7.         Car_No = UserForm1.ComboBox1
  8.         .Rows(2).Cells(1).AutoFilter Field:=9, Criteria1:=UCase(Car_No)
  9.         xlRow = .Rows(2).Cells(9).End(xlDown).Row
  10.         If xlRow <> Rows.Count Then
  11.             Set Rng = .Cells.SpecialCells(xlCellTypeVisible)
  12.         Else
  13.             MsgBox "找不到 車號 !! " & Car_No:      Exit Sub
  14.         End If
  15.         '**********
  16.         On Error Resume Next                '啟動的錯誤處理程式: 有錯誤繼續下一行程式碼
  17.         Sheets(Car_No).Activate      '沒有車號工作表會有錯誤
  18.         If Err.Number <> 0 Then             '程式有錯誤
  19.             Sheets.Add , Sheets("sheet1")   '新增工作表
  20.             '***消除 有錯誤繼續下一行程式碼的指令***
  21.             On Error GoTo 0                 '停止現在程序裏任何已啟動的錯誤處理程式。
  22.         End If
  23.         '**********************
  24.         With ActiveSheet
  25.             .Cells.Clear
  26.             Rng.Copy .[a1]
  27.             Application.CutCopyMode = False
  28.             .Name = .[i3]
  29.             .Cells(.Rows.Count, "O").End(xlUp).Offset(1, -1) = "合計"
  30.             .Cells(.Rows.Count, "O").End(xlUp).Offset(1) = Application.Sum(.Range("O:O"))    '金額加總
  31.         End With
  32.         
  33.         '--***  是否可以不移除或移除3筆---
  34.         If UserForm1.OptionButton1 Then   '***表單新增 OptionButton1 控制項 .Value=True
  35.             For Each E In Rng.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).EntireRow
  36.                 If E.Row > 2 Then E.Delete
  37.             Next
  38.         End If
  39.         '-- ****************
  40.         .AutoFilterMode = False
  41.         .Activate
  42.     End With
  43. End Sub
複製代碼
回復 6# c_c_lai
.Cells.SpecialCells(xlCellTypeVisible).SpecialCells(xlCellTypeConstants).Offset(2).Delete xlUp
是有錯誤的已修正 試試看
作者: av8d    時間: 2012-10-16 13:59

回復 8# GBKEE


    學習了，我真的才疏學淺，我要加倍努力!



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