多筆EXCEL搜尋的用法[已解決 2011-05-11] - Excel程式區

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兔年全勤獎章

11^# 跳轉到 »

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

回復 10# mark15jill
3.那個原始碼是套用大大您的可是剛有試驗過不能不過後來有新增我列的兩行就OK了...就是sheet1 變成 TEXT名稱 (不知道哪出錯-0-)
可傳上完整程式碼看看??

TOP

mark15jill

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

12^#

發表於 2011-5-11 08:05 | 只看該作者

這些是以大大的程式碼加以延伸的..

Sub 按鈕5_Click()
Dim Sh As Object
On Error Resume Next
Set Sh = ThisWorkbook.Sheets(1)
With Workbooks.Add(xlWBATWorksheet)
Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]
.SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1
.Close 0
Sheets("Sheet1").Select
Sheets("Sheet1").Name = Sh.TextBox1
End With
End Sub

複製代碼

回復 11# GBKEE

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兔年全勤獎章

13^#

發表於 2011-5-11 09:26 | 只看該作者

回復 12# mark15jill
修改的程式,真的有達到你目地嗎?
Sub 按鈕5_Click()
Dim Sh As Object
On Error Resume Next    'On Error : 當程式執行時有錯誤時, Resume Next : 繼續處裡下一個程式碼
Set Sh = ThisWorkbook.Sheets(1)
With Workbooks.Add(xlWBATWorksheet)
      Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]
      .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1
      'SaveAs: 當目錄中有相同的檔名系統會詢問是否覆蓋原檔案  如選擇 [否] 或[取消] 都會產生錯誤值
      'On Error 就是在處裡這錯誤
      .Close 0                                '如選擇 [否] 或[取消]: 檔案關閉且不存檔
      Sheets("Sheet1").Select '檔案已關閉:請問這裡的 Sheets("Sheet1")是哪一個??
      Sheets("Sheet1").Name = Sh.TextBox1
End With
End Sub

TOP

mark15jill

　暱稱: 隨風飄蕩的羽毛
　頭銜: [御用]潛水艇

高中生 Rank: 3 Rank: 3

帖子: 852
主題: 79
精華: 0
積分: 918
點名: 0
作業系統: Windows 7 , XP
軟體版本: Office 2007, Office 2003,Office 2010,YoZo Office
閱讀權限: 50
性別: 男
來自: 宇宙
註冊時間: 2011-4-8
最後登錄: 2024-2-21

14^#

發表於 2011-5-11 10:35 | 只看該作者

本帖最後由 mark15jill 於 2011-5-11 10:39 編輯

End Sub[/code]回復 13# GBKEE
剛剛發現我那兩行位置有打錯= =....(應該是後來我又亂改沒注意到抱歉ˊˋ)
原始碼差別已經附加檔案

以下是兩者的代碼

台灣的部份
Sub 按鈕5_Click()
Dim Sh As Object

On Error Resume Next

Set Sh = ThisWorkbook.Sheets(1)

With Workbooks.Add(xlWBATWorksheet)
      Sheets("sheet1").Select
      Sheets("sheet1").Name = Sh.TextBox1 ' 新增的那個檔案內的名稱為 TEXT的字眼
      Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]

      .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1

      .Close 0

End With

End Sub

美國的部份
Sub 按鈕5_Click()
Dim Sh As Object

On Error Resume Next

Set Sh = ThisWorkbook.Sheets(1)

With Workbooks.Add(xlWBATWorksheet)

      Sh.UsedRange.Offset(1).Copy .Sheets(1).[A1]

      .SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1

      .Close 0
      ' Sheets("Sheet1").Select
      ' Sheets("Sheet1").Name = Sh.TextBox1
End With

End Sub

附加檔案內有兩個 TXT 和 EXCEL檔案  分別為美國和台灣