彰化一整天的論壇

 找回密碼
 立即註冊
樓主: z22344566

我需要用公司名稱來跟改sheet的名字

[複製鏈接]
 樓主| 發表於 2016-11-6 15:30:31 | 顯示全部樓層
本帖最後由 z22344566 於 2016-11-6 17:22 編輯
imingho 發表於 2016-11-2 23:14
合併是可以的.我給你類似的程式碼.您參考修改看看.有問題再提出.
售價那是虛擬幣.每天登入後論壇會有2塊金 ...

不好意思
我是個程式新手也透過 EXCEL VBA學習中
但我參考過後
完全不會修改
可以麻煩示範一次給我看嗎.....
謝謝
回復 支持 反對

使用道具 舉報

發表於 2016-11-7 08:51:49 | 顯示全部樓層
z22344566 發表於 2016-11-6 15:30
不好意思
我是個程式新手也透過 EXCEL VBA學習中
但我參考過後

您好,
    我在前一封有跟您講要如何解決的方法.
處理步驟如下
1.若工作表存在.選取目前的工作表內容
2.複製
3.切換到已存在工作表
4.找到有資料的最後一列
5.貼上
這5個步驟中的那一個您遇到問題?
您可以利用錄製巨集的方式取得相關的程式碼.
一次提問您所遇到的一個問題點的問題.




回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-11-7 14:29:41 | 顯示全部樓層
imingho 發表於 2016-11-7 08:51
您好,
    我在前一封有跟您講要如何解決的方法.
處理步驟如下

請問一下 我該如何判斷資料表是否存在
因為是修改過後的名稱 XXX公司1 XXX公司2 XXX公司3 這該怎麼取


回復 支持 反對

使用道具 舉報

發表於 2016-11-7 15:14:40 | 顯示全部樓層
本帖最後由 imingho 於 2016-11-7 15:20 編輯
z22344566 發表於 2016-11-7 14:29
請問一下 我該如何判斷資料表是否存在
因為是修改過後的名稱 XXX公司1 XXX公司2 XXX公司3 這該怎麼取
  1.              Sheets(x).Name = Worksheets(x).Range("B5").Value & x '加上數字讓它變成惟一
複製代碼
這段程式碼要拿掉.改成我說的那幾個步驟.
您把這段程式碼拿掉.或是註解,就不會看到有xx公司1 xx公司2.
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-11-7 23:57:08 | 顯示全部樓層
imingho 發表於 2016-11-7 15:14
這段程式碼要拿掉.改成我說的那幾個步驟.
您把這段程式碼拿掉.或是註解,就不會看到有xx公司1 xx公司2.
...

你好 現在拿掉那行指令 變成XXX公司 後面的sheet  變數字  那我該如何定義後面那些的sheet 讓他與前面那個檔案做合併   是要使用FOR迴圈嗎  還有在 3.切換到已存在工作表 我也很不清楚 我真的很不懂 麻煩解答 謝謝   





這是我參考錄製巨集打出的
If Sheet(x).Name = value . Select.Range("A3:G22")
              Selection.Cut
                 Sheets(x-1).Select
                 ActiveWindow.SmallScroll Down:=6
                 Range("A23").Select
                 ActiveSheet.Paste

但是不能執行,如果用錄製巨集那下一份的資料也是要重新錄製這樣嗎?   感謝解答麻煩了
回復 支持 反對

使用道具 舉報

發表於 2016-11-8 17:02:39 | 顯示全部樓層
本帖最後由 imingho 於 2016-11-8 17:08 編輯
z22344566 發表於 2016-11-7 23:57
你好 現在拿掉那行指令 變成XXX公司 後面的sheet  變數字  那我該如何定義後面那些的sheet 讓他與前面那 ...

您上傳您寫的excel檔案.我幫您看.還有問問題,一次只問一個問題點.您一次問那麼多.我不知道要先回那一個.我先回答您一個問題.
切換工作表的寫法(.select就是您按工作表切換的意思)
例如:Sheets("已存在工作表").Select

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-11-8 17:56:04 | 顯示全部樓層
imingho 發表於 2016-11-8 17:02
您上傳您寫的excel檔案.我幫您看.還有問問題,一次只問一個問題點.您一次問那麼多.我不知道要先回那一個.我 ...

不好意思 下次會改進
謝謝

test.xlsm

38.6 KB, 下載次數: 4

回復 支持 反對

使用道具 舉報

發表於 2016-11-8 21:11:17 | 顯示全部樓層
z22344566 發表於 2016-11-8 17:56
不好意思 下次會改進
謝謝

我之前有說要執行之前要先把工作表改成流水號,您給我的程式就少了這段程式.
renew_01.jpg

1.之前的回覆

底下是我幫您修改的程式碼
  1. Sub RenameTabs()

  2.     Call ReNewTabs  '將所有工作表變成流號
  3.    
  4.     For x = 1 To Sheets.Count
  5.    
  6.        If Worksheets(x).Range("B5").Value <> "" Then
  7.           If check_sheet(Sheets(x), Worksheets(x).Range("B5").Value) = False Then
  8.              Sheets(x).Name = Worksheets(x).Range("B5").Value
  9.           Else
  10.              'Sheets(x).Name = Worksheets(x).Range("B5").Value & x '加上數字讓它變成惟一
  11.             
  12.             
  13.              '選取要複製的範圍
  14.              Range("A3:G22").Select
  15.             
  16.              '複製
  17.              Selection.Copy
  18.             
  19.              '切換到已存在工作表
  20.              Sheets(x).Select
  21.                
  22.              '找最後一列
  23.              lastrow = Sheets(x).Cells.SpecialCells(xlCellTypeLastCell).Row
  24.              '將最後一列的A1選取
  25.              Range("A" & (lastrow + x)).Select
  26.             
  27.              '貼上
  28.              ActiveSheet.Paste
  29.             
  30.             
  31.           End If
  32.        End If
  33.    
  34.     Next

  35. End Sub
  36. Function check_sheet(ByVal objSheet, ByVal strSheetName)
  37.     '檢查工作表名稱是否存在
  38.     check_sheet = False
  39.     For i = 1 To objSheet.Parent.Sheets.Count
  40.         If objSheet.Parent.Sheets(i).Name = strSheetName Then
  41.            check_sheet = True
  42.            Exit For
  43.         End If
  44.     Next
  45. End Function

  46. Sub ReNewTabs()
  47.     '重設工作表為數字
  48.     For x = 1 To Sheets.Count
  49.         Sheets(x).Name = x
  50.     Next

  51. End Sub
複製代碼


test.xlsm

49.28 KB, 下載次數: 0

售價: 2 金錢  [記錄]  [購買]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2016-11-11 19:14:55 | 顯示全部樓層
imingho 發表於 2016-11-8 21:11
我之前有說要執行之前要先把工作表改成流水號,您給我的程式就少了這段程式.

1.之前的回覆

test.png


老師您好,我希望我的EXCEL能夠做出這樣的合併
但是我不知道我該下什麼語法才能夠讓這樣的工作表做出合併
底下有我用錄製巨集的方式的程式碼
我該用什麼方式或者是語法能夠讓它全部套用到整個EXCEL檔案嗎
難不成每次都要重新錄製一次嗎

再度的麻煩 真不好意思

謝謝




Sub RenameTabs()





    For x = 1 To Sheets.Count

    Application.DisplayAlerts = False

       If Worksheets(x).Range("B5").Value <> "" Then
          If check_sheet(Sheets(x), Worksheets(x).Range("B5").Value) = False Then
             Sheets(x).Name = Worksheets(x).Range("B5").Value
          Else
             'Sheets(x).Name = Worksheets(x).Range("B5").Value & x '加上數字讓它變成惟一

             Range("A5").Select

             Range(Selection, Selection.End(xlToRight)).Select
             Range(Selection, Selection.End(xlDown)).Select

             Selection.Copy

             Sheets("永安").Select

             Selection.End(xlDown).Select

             ActiveSheet.Paste

             ActiveCell.Offset(1, 0).Select

             Sheets("2").Select

             ActiveWindow.SelectedSheets.Delete

             Application.DisplayAlerts = True


          End If
       End If

    Next


End Sub
Function check_sheet(ByVal objSheet, ByVal strSheetName)
    '檢查工作表名稱是否存在
    check_sheet = False
    For i = 1 To objSheet.Parent.Sheets.Count
        If objSheet.Parent.Sheets(i).Name = strSheetName Then
           check_sheet = True
           Exit For
        End If
    Next
End Function
Sub ReNewTabs()
    '重設工作表為數字
    For x = 1 To Sheets.Count
        Sheets(x).Name = x
    Next

End Sub

回復 支持 反對

使用道具 舉報

發表於 2016-11-12 10:41:10 | 顯示全部樓層
本帖最後由 imingho 於 2016-11-12 11:19 編輯
z22344566 發表於 2016-11-11 19:14
老師您好,我希望我的EXCEL能夠做出這樣的合併
但是我不知道我該下什麼語法才能夠讓這樣的工作表做出 ...

您用for 迴圈跟sheets.count時,
在迴圈中不能刪除工作表.因為您刪除後.會造成sheet.count的數目不對.
正常的作法是用for each 的寫法.
或是迴圈的寫法改成
For x = Sheets.Count to 1 step -1

錄製巨集只要一次.其它只要把它的文字改成變數,就可以全部執行

請下載附檔回去執行RenameTabs1
看是不是您要的.


test合併工作表前.xlsm

37.7 KB, 下載次數: 8

售價: 2 金錢  [記錄]

回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)  |网站地图

GMT+8, 2018-9-24 01:52 , Processed in 0.116110 second(s), 19 queries .

Powered by Discuz! X3.2

© 2001-2013 Comsenz Inc.

快速回復 返回頂部 返回列表