請教EXCEL VBA高手,如何搜集各SHEET中的特定資料

有一WORKBOOK中含有數十個WORKSHEET,在下想逐一批次的處理每個SHEET,COPY出各SHEET中的符合我要求的資料"列"的值(資料列中可能是公式,我只要它的"值與格式",而不要公式),並把這些抽出的資料集中到另外新增的SHEET(SHEET取名為"結果")中,一列一列的往下排。

抽取SHEET的原則為當SHEET中的 H欄 內容不等於空白時,就把那非空白儲存格它所在的位置整列的值與格式COPY到新增的SHEET中,一列一列的往下排搜集起來,依此原則,把所有的SHEET都處理完。所以最後我只要看名為"結果" 這個SHEET就能看到所有我想要的資料了。

希望在下的描述不會很模糊,我已盡力的表達出我的問題了,非常感謝幫忙的大大了,這能省下在下不少的工作時間。 尤衷的感謝

Update:

To 准提部林 大大,您寫的程式碼確實可用,抱歉了,可以再加問一下,如果我本來要搜集的目標欄位為H欄,可以把它改成會 "跳出詢問視窗" 讓我輸入決定是那個欄位嗎? 假設我要搜集的欄位為K欄的非空白值的列,我只要在跳出的詢問視窗輸入K,然後按確定,那程式就會選擇K欄來搜集我要的資料到SHEET名為"結果"的工作表內。 非常感謝您,辛苦大大了。

Update 2:

哈,我參考別人的作法搞定了,沒問題了,謝謝 准提部林 大大,請把您的意件轉到回答的版面讓我奉上我的分數吧! 非常感謝! 有您真好!

2 Answers

Rating
  • 6 years ago
    Best Answer

    沒樣本檔,大約寫一下,請測試看看:結果表請自行建立

    Sub CopyHRow()

    Dim S1 As Worksheet, S2 As Worksheet, i&, y&, N&

    Application.ScreenUpdating = False

    Set S1 = Sheets("結果表")

    S1.Cells.Clear

    For Each S2 In Sheets

    2013-08-06 15:54:10 補充:

      If S2.Name = S1.Name Then GoTo 101

      y = S2.[H65536].End(3).Row

      For i = 1 To y

        If S2.Range("H" & i) <> "" Then

        N = N + 1: S2.Rows(i).Copy

    2013-08-06 15:54:51 補充:

        S1.Rows(N).PasteSpecial Paste:=xlFormats

        S1.Rows(N).Value = S2.Rows(i).Value

       End If

      Next i

    101: Next

    End Sub

    2013-08-07 09:55:55 補充:

    EXCEL VBA.將多張工作表符合條件者的列資料貼至結果表

                             <.准提部林.>

    ---------------------------------

    ■基本需求:

     逐頁檢查各工作表的H欄,若儲存格中為〔非空格〕,

     則將〔整列〕複製格式及其值貼至〔結果表〕中。

     註:資料區含有公式,不可直接COPY。

     

    ■程式碼:

     Sub CopyHRow()

     Dim S1 As Worksheet, S2 As Worksheet, xE As Range, i&, y&, N&, GD$

     On Error GoTo 1

     GD = [A1]:  Set xE = Range(GD & 1) '在A1輸入檢測欄位,例如:H

     Application.ScreenUpdating = False

     Set S1 = Sheets("結果表")

     S1.Cells.Clear

     For Each S2 In Sheets

       If S2.Name = S1.Name Then GoTo 101

       y = S2.Range(GD & 65536).End(3).Row

       For i = 1 To y

        If S2.Range(GD & i) <> "" Then

         N = N + 1: S2.Rows(i).Copy

         S1.Rows(N).PasteSpecial Paste:=xlFormats

         S1.Rows(N).Value = S2.Rows(i).Value

        End If

       Next i

     101: Next

     1: End Sub

     

    ■說明:

     1.因含格式,採逐列複製,速度上較慢。

     2.若要將〔H〕欄改為可動態指定,

       可利用〔結果表〕的A1當輸入介面,比較簡單。

    ---------------------------------

  • Anonymous
    6 years ago

    http://Lv333。com 這家不錯超3A品質,買幾次啦,跟真的一樣。

    勂俜

Still have questions? Get your answers by asking now.