[發問] 請問如何在貼資料時，第二筆資料自動貼自第一筆資料下方??(已解決)

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2011-8-16 19:56 | 只看該作者

[發問] 請問如何在貼資料時，第二筆資料自動貼自第一筆資料下方??(已解決)

本帖最後由棋語鳥鳴於 2011-8-19 17:39 編輯

如標題所示:我想貼不同來源的資料至同一個工作表中，請問要如何設定巨集，使第二筆資料貼至第一筆資料下方!

test.rar (8.41 KB)

樓主熱帖

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

2^#

發表於 2011-8-17 14:31 | 只看該作者

回復 1# 棋語鳥鳴

Sub Ex()
Dim E, Rng As Range
With Sheets("資料複製區")
For Each E In Array(1, 3, 5)
Set Rng = .Range(.Columns(E).Cells(2), .Columns(E).Cells(2).End(xlDown))
With Sheets("資料黏貼區").Range("A" & Rows.Count).End(xlUp)
If .Cells(1).Row = 1 Then
.Cells(1).Resize(Rng.Rows.Count) = Rng.Value
Else
.Cells(2).Resize(Rng.Rows.Count) = Rng.Value
End If
End With
Next
End With
End Sub

複製代碼

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

3^#

發表於 2011-8-17 18:40 | 只看該作者

本帖最後由棋語鳥鳴於 2011-8-17 18:43 編輯

回復 2# GBKEE
1.此巨集測試結果，如果2、3沒資料，會出現錯誤!請教要如何修改??

2.如果資料來源都在A欄(但是塞選值不一樣)，但也是想每次都貼至前一次的值下方，請問要如何更改其巨集?

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

4^#

發表於 2011-8-18 15:54 | 只看該作者

回復 3# 棋語鳥鳴
Q1.此巨集測試結果，如果2、3沒資料，會出現錯誤!請教要如何修改??
2樓的程式是依據你的範例而作的 ,你要說明清楚有哪些狀況
Q2.如果資料來源都在A欄(但是塞選值不一樣)，但也是想每次都貼至前一次的值下方，請問要如何更改其巨集?
請問什麼是塞選值不一樣

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

5^#

發表於 2011-8-18 17:59 | 只看該作者

回復 4# GBKEE
不好意思是我題目沒寫清楚!
Q1,資料1、2、3為多筆數據連結之結果，有時會出現空白(無數據)之情況!
Q2,塞選值不一樣是指有時可能會有好幾個檔案(但是會分別丟進去塞選出我要的值)，而想把這幾個不同檔案的值塞選出來轉到同一個工作表中，作資料整理。

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

6^#

發表於 2011-8-19 14:50 | 只看該作者

回復 5# 棋語鳥鳴

Sub Ex()
Dim E, Rng As Range
With Sheets("資料複製區")
For Each E In .UsedRange.Columns
If Application.CountA(E) > 1 Then
Set Rng = .Range(E.Cells(2), E.Cells(Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants)
With Sheets("資料黏貼區").Range("A" & Rows.Count).End(xlUp)
If .Cells(1).Row = 1 Then
Rng.Copy .Cells(1)
Else
Rng.Copy .Cells(2)
End If
End With
End If
Next
End With
End Sub

複製代碼

帖子: 178
主題: 53
精華: 0
積分: 242
點名: 0
作業系統: xp
軟體版本: 2007
閱讀權限: 20
註冊時間: 2011-2-22
最後登錄: 2024-7-5

7^#

發表於 2011-8-19 17:36 | 只看該作者

回復 6# GBKEE

這次測試(ok)已符合我的需求，謝謝您細心的指導!