[發問] 多筆EXCEL搜尋的用法[已解決 2011-05-11]

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

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

16^#

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

回復 15# GBKEE

多謝指導><
習慣性都會多指定那個...

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

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

15^#

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

回復 14# mark15jill
9樓程式碼中的 .Sheets(1).Name = Sh.TextBox1 '工作表名稱
這紅點表示在所新增的活頁簿裡不必再有 Sheets(1).Select

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

帖子: 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檔案  分別為美國和台灣

查詢比對.rar (10.14 KB)

帖子: 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

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

帖子: 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

帖子: 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-)
可傳上完整程式碼看看??

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

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

10^#

發表於 2011-5-10 17:27 | 只看該作者

回復 9# GBKEE

1.當然沒動作XD!! 因為不知道要怎寫所以 ... 不過現在已經解決了謝謝
3.那個原始碼是套用大大您的可是剛有試驗過不能不過後來有新增我列的兩行就OK了...就是sheet1 變成 TEXT名稱 (不知道哪出錯-0-)
4.了解那行的意思了... 謝謝...

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

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

9^#

發表於 2011-5-10 16:39 | 只看該作者

回復 8# mark15jill
1.兩個都沒內容+.+
沒有程式碼阿, 會有動作嗎?
3.新增後的活頁簿名稱未改變.. 不過剛剛已經解決了..

Private Sub 存檔()
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]
.Sheets(1).Name = Sh.TextBox1 '工作表名稱
.SaveAs ThisWorkbook.Path & "\" & Sh.TextBox1
.Close 0
End With
End Sub

複製代碼

4.因為我範例檔案只有到H欄位實際上卻是到Z欄位0.0..
改紅字部位
.Offset(1).Resize(1,26) = Sh.Range(Sh.Cells(Rng.Row, "A"), Sh.Cells(Rng.Row, "Z")).Value

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

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

8^#

發表於 2011-5-10 15:59 | 只看該作者

本帖最後由 mark15jill 於 2011-5-10 16:06 編輯

回復 7# GBKEE

1.兩個都沒內容+.+
Sub 按鈕5_Click()

End Sub
Sub 按鈕6_Click()

End Sub

2.已經解決無法存檔和無效問題QQ  謝謝您
剛剛把程式分開裝...
拆成兩部份丟去兩邊..

3.新增後的活頁簿名稱未改變.. 不過剛剛已經解決了..
原本是sheet1.  我多+了兩行..

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

4.另外請問一下
如果那樣的話那是只要同一列的資料不管有多少都會列出來嗎??
因為我範例檔案只有到H欄位實際上卻是到Z欄位0.0..

再次感謝您  :lol