iT邦幫忙

0

EXCEL VBA 搜尋工作表1特定欄,若包含複製整行至工作表2求解

https://ithelp.ithome.com.tw/upload/images/20190917/20120368LnAuqGCbKA.jpg
主為主隊,種為種子隊,數字為場次。舉例在工作表1的C到I欄中搜尋"K"隊
若有含"K"就複製到工作表2,但不重複列出,希望各位大大幫忙,小弟寫的孬孬的還是不大行用

ncte_cat iT邦新手 5 級 ‧ 2019-09-17 08:50:16 檢舉
你可以上圖,或是你的VAB上來...這樣看很亂..
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

2 個回答

0
jasonh
iT邦新手 5 級 ‧ 2019-09-17 09:17:51
最佳解答

Sub find_K_in_C2I()
Dim arr()
Sheets("工作表1").Select
Rcnt = [a1].End(xlDown).Row
Ccnt = [a1].End(xlToRight).Column
ReDim arr(1 To Rcnt)
arr(1) = 1
For i = 2 To Rcnt
arr(i) = Application.CountIf(Range(Cells(i, 3), Cells(i, Ccnt)), "K")
Next i
k = 1
For i = 1 To Rcnt
If arr(i) > 0 Then
Sheets("工作表2").Cells(k, 1).Resize(1, Ccnt) = Sheets("工作表1").Cells(i, 1).Resize(1, Ccnt).Value
k = k + 1
End If
Next i
End Sub

jasonh iT邦新手 5 級 ‧ 2019-09-17 09:36:33 檢舉

Sheets("工作表2").Cells(k, 1).Resize(1, Ccnt) = Sheets("工作表1").Cells(i, 1).Resize(1, Ccnt).Value
也可更改為
Sheets("工作表2").Rows(k) = Sheets("工作表1").Rows(i).Value

1
Neish
iT邦研究生 1 級 ‧ 2019-09-17 09:12:01

問題描述提到 舉例在工作表1的C到I欄中搜尋"K"隊 但是根據上述例子應該是J欄

這列 1 主 種 1 2 3 4 5 6 7 應該不會被抓到工作表2但我看你結果有抓

所以我就預設放到工作表2最上面

跑出來的結果參考及檔案如下
https://c-t.work/s/7d7836a5d05144

應該可以滿足您的需求

Sub test()

    Dim i As Integer
    Dim j As Integer
    Dim start_row As Integer
    
    '直欄迴圈(由上而下)
    For i = 1 To Sheets(1).Range("A65536").End(xlUp).Row
    
        '橫列迴圈從(C欄開始 由左至右)
        For j = 3 To 10
        
            '有出現K則COPY到Sheet2 並跳出橫列迴圈
            If Sheets(1).Cells(i, j) = "K" Then
            
                'Sheet2目的位置
                start_row = Sheets(2).Range("A65536").End(xlUp).Row + 1
                Sheets(1).Rows(i).Copy Sheets(2).Range("A" & start_row)
                Sheets(2).Range("A" & start_row) = start_row
                Exit For
                
            End If
            
        Next
        
    Next
    
End Sub
peterzxcv iT邦新手 5 級 ‧ 2019-09-17 14:08:17 檢舉

Neish大寫的很優美,我之前提問的有誤,第一欄是希望保有主場下相關文字,導致試跑有些問題,第一行條件必不符搜尋所以是指定複製過去的,主要核心的部分幾乎完成,感謝https://ithelp.ithome.com.tw/upload/images/20190917/201203689LNHYuONJc.jpg

我要發表回答

立即登入回答