iT邦幫忙

0

求助 Excel VBA 搜尋關鍵字後貼到其他的tab的寫法

各位先備好

如果有一個excel裡面資料大概有50列,而每一行都是記載著不同的資訊,譬如:姓名/電話/email...等等

我的問題是因為每次都要針對某一行的內容做搜尋及重新擺位,譬如說如果那一列中有"新竹"或是有"高雄",我就要自己先開一個新tab,然後把那一列剪下來,再貼到新的tab中,等於這樣的動作我要做50次。

想說請問可否請教如何寫出這樣的程式碼,讓程式自動把有出現"新竹"或是"高雄"的行,能各自貼到由程式自創的新竹tab或是高雄tab中。

可以請問一下各位要大概怎麼寫這個VBA的程式碼嗎? 謝謝加拜託~~


1 則留言

0
RoT
iT邦新手 5 級 ‧ 2020-11-16 14:22:58

cnchern0614, 你好

能否提供部分資料 / 資料格式, 方便解決問題

歡迎討論

看更多先前的回應...收起先前的回應...

RoT 您好

基本上,原始資料大概如下,我想請問是否可以用VBA來幫我把住在不同縣市的同學做分類,分類方式如下:

  1. VBA 根據縣市分類北中南三區
  2. VBA 自動開新tab,並且各自命名"北"/"中"/"南"
  3. VBA 自動將北中南區各縣市內容直接貼到各自"北"/"中"/"南"三個不同的tab中。

範例 excel 我放雲端,希望能請 Rot 哥指點VBA碼,謝謝。

https://ithelp.ithome.com.tw/upload/images/20201116/20132595LCAh3BglCg.jpg

RoT iT邦新手 5 級 ‧ 2020-11-16 23:10:40 檢舉

cnchern0614, 你好

依照你給的資料

https://ithelp.ithome.com.tw/upload/images/20201116/20124248ttwr6uB0qV.jpg

執行 VBA 如下

    Sub Sample()
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "北"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "中"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "南"

    Worksheets("工作表1").Activate
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=台北市"
    Worksheets("工作表1").Range("A1:G2").Select
    Selection.Copy
    Worksheets("北").Range("A1").PasteSpecial
    End Sub

執行結果如下圖

https://ithelp.ithome.com.tw/upload/images/20201116/20124248ezewpVD1l3.jpg

工作表1 就是你的資料, 接著 VBA 的部分 2 ~ 4 行,

是新增 / /

第 6 行, 是篩選原始資料為 台北市

將結果複製到

給你參考, 歡迎討論

Rot 您好

首先謝謝您,但是我正想說如法炮製時,發現好像沒有辦法把所有資料分到三個不同的tab中,好像只有一些縣市會進去,是否能請您再幫我檢查一下,謝謝您。

 Sub Sample()
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "北"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "中"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "南"

  Worksheets("工作表1").Activate
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=台北市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("北").Range("A1").PasteSpecial

  Worksheets("工作表1").Activate
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=新北市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("北").Range("A1").PasteSpecial

  Worksheets("工作表1").Activate
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=桃園縣"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("北").Range("A1").PasteSpecial

    Worksheets("工作表1").Activate
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=新竹縣"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("北").Range("A1").PasteSpecial
    
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=台中市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("中").Range("A1").PasteSpecial
    
       Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=嘉義市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("南").Range("A1").PasteSpecial
    
        Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=台南市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("南").Range("A1").PasteSpecial
    
        Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=高雄市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("南").Range("A1").PasteSpecial
    
    
    
    End Sub
RoT iT邦新手 5 級 ‧ 2020-11-17 09:36:36 檢舉

cnchern0614, 你好

我這邊舉例一下你的問題, 你 第 5 ~ 14 行

  Worksheets("工作表1").Activate
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=台北市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("北").Range("A1").PasteSpecial

  Worksheets("工作表1").Activate
    Worksheets("工作表1").Range("A1:G13").AutoFilter Field:=5, Criteria1:="=新北市"
    Worksheets("工作表1").Range("A1:G13").Select
    Selection.Copy
    Worksheets("北").Range("A1").PasteSpecial

在篩選 台北市 複製到 貼上
接著篩選 新北市 複製到 貼上,
這邊將先前篩選貼上的 台北市 資料覆蓋掉了, 導致資料不正確

而這邊會有兩個問題

  1. 問題一
    Worksheets("工作表1").Range("A1:G13").Select

這邊 Range("A1:G13") 是篩選出來的資料範圍
可以看我先前回應的第 7 行, 為 Range("A1:G2")
所以在篩選 台北市新竹縣 資料筆數不一樣, 如下圖

https://ithelp.ithome.com.tw/upload/images/20201117/20124248vkbMLjOz4L.jpg

  1. 問題二
    Worksheets("北").Range("A1").PasteSpecial
    '這邊僅為 北 舉例

你的第 5 ~ 14 行, 在 貼上了 台北市 資料, 新竹縣 資料要接在 台北市 下面
https://ithelp.ithome.com.tw/upload/images/20201117/20124248Nc6XMIaubn.jpg

歡迎討論

RoT 您好

謝謝您仔細的回應,實在已經非常感激,唯小弟實在不是什麼程式語言的能手,在這理之後真的不知道如何往下一步前進,不知道能否跟您求完整的解決之道,謝謝。

RoT iT邦新手 5 級 ‧ 2020-11-17 10:51:11 檢舉

cnchern0614, 你好

Sub Sample()
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "北"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "中"
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "南"
    
    For i = 2 To 13
        Worksheets("工作表1").Activate
        Select Case Cells(i, 5).Value
            Case Is = "台北市"
                Worksheets("工作表1").Range("A" & i & ":G" & i).Select
                Selection.Copy
                Worksheets("北").Activate
                Worksheets("北").Range("A" & Worksheets("北").Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
            Case Is = "台南市"
                Worksheets("工作表1").Range("A" & i & ":G" & i).Select
                Selection.Copy
                Worksheets("南").Activate
                Worksheets("南").Range("A" & Worksheets("南").Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial
        End Select
    Next i
End Sub

以此類推 第 8 ~ 12 行

以及資料筆數, 第 5 行要跟著改

歡迎討論

Rot 您好,抱歉現在才回覆,我剛剛有做些測試,已經能夠滿足我的使用,但是我有個地方想要再請教您一下

我發現如果我的表格,如果表格內是"台北市 公館"字樣,好像不會被帶進去"台北市 公館"這個tab,而是會被進去"台北市"去,請問一下是不是要怎麼設定搜尋的條件,才不會發生這樣的誤判,謝謝

我目前的code是這樣,再請Rot大大能否解惑,謝謝

Case Is = "台北市 公館"
Worksheets("工作表1").Range("A" & i & ":G" & i).Select
Selection.Copy
Worksheets("台北市 公館").Activate
Worksheets("台北市 公館").Range("A" & Worksheets("台北市 公館").Cells(Rows.Count, 1).End(xlUp).Row + 1).PasteSpecial

抱歉,我忘了補充一下,因為現有的系統會在台北市跟公館之間產生一個空白格,因為資料很多筆,大概有幾萬筆,我不太可能一筆一比去清理這個空格,所以我在想是不是這個空格造成code在搜尋時會誤判,謝謝

我要留言

立即登入留言