12
返回列表 上一主題 發帖

[發問] 不同sheet之間抓取資料

ldneye

帖子
13 
主題
2 
精華
0 
積分
15 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-10-25 
最後登錄
2013-12-2 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-10-25 07:28 | 只看該作者

[發問] 不同sheet之間抓取資料

最近剛接觸VBA 所以有些東西還不是很熟
下面這個問題我google一天了還是找不到解決的辦法




我有兩個column 的資料 ( 文字)   分別在不同的工作表

sheet1 :   a
                   b
                   c
                   d
                   e
                   f   

sheet2 : a
                 1 2 3 4 5
                 6 7 8 9 10
                 b
                 1 2 3 4 5
                 6 7 8 9 10
                 c
                1 2 3 4 5
                6 7 8 9 10
               e
               1 2 3 4 5
               6 7 8 9 10
               11 12  13  14 15
               f
               1 2 3 4 5
               6 7 8 9  1
               1  12  6  74  8

我想要是設一個迴圈

if sheet1.range("A" & i) = sheet2.range("A" & j )

copy  sheet2.range("A2 : E2")
paste in sheet1.range("B1 :E1")


...

( 也就是在sheet2裡的 a的下面的 1 2 3 4 5 要貼到 sheet1 a 的左邊 ,

  最後迴圈跑完的結果在sheet1是 :

a 1 2 3 4 5
b 1 2 3 4 5
c 1 2 3 4 5
d 1 2 3 4 5
e 1 2 3 4 5
f 1 2 3 4 5

這樣講不知道清不清楚

如果有疑問我還可以再補充

請各位大大教我一下怎麼寫這段程式吧

謝謝


我想要是設一個迴圈
收藏 分享

yuhuahsiao

帖子
17 
主題
0 
精華
0 
積分
22 
點名
0  
作業系統
xp 
軟體版本
2003 
閱讀權限
10 
性別
男 
來自
Hsinchu 
註冊時間
2013-9-5 
最後登錄
2024-7-23 
2#
發表於 2013-10-25 08:27 | 只看該作者
回復 1# ldneye


    請問sheet2
         a
         12345
          678910

都是在 A欄嘛 ?  
A1
A2
A3
或是  是
A1
A2 B2 C2 D2 E2
.....

TOP

ldneye

帖子
13 
主題
2 
精華
0 
積分
15 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-10-25 
最後登錄
2013-12-2 
3#
發表於 2013-10-25 08:32 | 只看該作者
A1
A2 B2 C2 D2 E2

TOP

genes

帖子
45 
主題
1 
精華
0 
積分
51 
點名
0  
作業系統
windows 7 
軟體版本
office 2003 
閱讀權限
20 
註冊時間
2013-4-16 
最後登錄
2013-12-30 
4#
發表於 2013-10-25 12:19 | 只看該作者
回復 3# ldneye


    請附上檔案

TOP

ldneye

帖子
13 
主題
2 
精華
0 
積分
15 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-10-25 
最後登錄
2013-12-2 
5#
發表於 2013-10-31 21:06 | 只看該作者
回復 4# genes

Private Sub CommandButton1_Click()

Sheets("Return").Select
finalrow = ActiveSheet.UsedRange.Rows.Count
Sheets("2006_1").Select
finalrow06 = ActiveSheet.UsedRange.Rows.Count

For j = 2 To finalrow06
For i = 1 To finalrow -5

If Sheets("2006_1").Cells(1, j) = Sheets("Return").Cells(1, i) Then
S
heets("Return").Select
Sheets("Return").Range(Range("A" & i + 2), Range("A" & i + 2).Offset(0, 12)).Copy

With Sheets("2006_1")
     .Select
     .Range(Range("B" & j), Range("B" & j).Offset(0, 12)).Select
End With
   
ActiveSheet.Paste
Sheets("2006_1").Select
End If
Next
Next

End Sub

TOP

ldneye

帖子
13 
主題
2 
精華
0 
積分
15 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-10-25 
最後登錄
2013-12-2 
6#
發表於 2013-10-31 23:54 | 只看該作者
[版主管理留言]
  • GBKEE(2013/11/1 06:57): genes 請你附檔,沒有附檔如同瞎子摸象

抱歉  
If Sheets("2006_1").Cells(1, j) = Sheets("Return").Cells(1, i) Then

應該是

If Sheets("2006_1").Cells(j,1) = Sheets("Return").Cells( i,1) Then

TOP

ldneye

帖子
13 
主題
2 
精華
0 
積分
15 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-10-25 
最後登錄
2013-12-2 
7#
發表於 2013-11-4 00:58 | 只看該作者
example.rar (117.51 KB) 回復 4# genes




謝謝版主提醒 因為我還不太習慣這個版的版規  如有觸犯 請多包涵

已經附上檔案了

我想要把第二個sheet ( Return) 裡面 2005 年的 return ,  一月份到十二月份的資料  複製貼上到  sheet( 2006_1)  對應到相同名字的 右邊

我的程式碼不知到哪邊出了問題

上網看了很久也看不出個所以然來

所以想請各位網路上好心的大大指點迷津

謝謝

如果還有觸犯版規的地方也請不吝告知 我會遵守的

TOP

genes

帖子
45 
主題
1 
精華
0 
積分
51 
點名
0  
作業系統
windows 7 
軟體版本
office 2003 
閱讀權限
20 
註冊時間
2013-4-16 
最後登錄
2013-12-30 
8#
發表於 2013-11-7 03:15 | 只看該作者
回復 7# ldneye

放到module上
2張worksheets公司名不對稱,自己改下code吧
  1. Option Explicit
  2. Sub test1()
  3. Dim finalrow As Integer
  4. Dim finalrow06 As Integer
  5. Dim j As Integer
  6. Dim i As Integer
  7. finalrow = Sheets("Return").UsedRange.Rows.Count
  8. finalrow06 = Sheets("2006_1").UsedRange.Rows.Count
  9. With ActiveWorkbook
  10. For j = 2 To finalrow06
  11. For i = 1 To finalrow - 5

  13. If .Sheets("2006_1").Cells(j, 1).Value = .Sheets("Return").Cells(i, 1).Value Then

  15. 'Sheets("Return").Select
  16. .Sheets("Return").Range(Cells(i + 2, 1), Cells(i + 2, 13)).Copy Destination:=.Sheets("2006_1").Range("B" & j)
  17. End If
  18. Next
  19. Next
  20. End With
  21. End Sub
複製代碼

TOP

ldneye

帖子
13 
主題
2 
精華
0 
積分
15 
點名
0  
作業系統
win7 
軟體版本
office 2007 
閱讀權限
10 
註冊時間
2013-10-25 
最後登錄
2013-12-2 
9#
發表於 2013-11-10 00:48 | 只看該作者
感謝前輩，我知道我的錯在哪裡了，就是公司名稱不對。
我以為 兩個cells 裡面的文字不用完全一樣只要相似就可以複製貼上( 甚至連前面有空格都不行 = = )

還有一個問題
就是我是想要把每間公司2005年的資料複製貼上到sheets 2006
但是由於他每個公司的資料開始的時間都不一樣 ，有的是從2002年開始 ，有的是從2005年開始
，甚至有的沒有資料！ 沒有辦法用 row + i 的方式推算出來，不知道前輩有沒有什麼更好的方法呢?
謝謝囉

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
10#
發表於 2013-11-10 08:35 | 只看該作者
回復 9# ldneye
試試看
  1. Option Explicit
  2. Sub Ex()
  3.     Dim e As Range, Rng(1 To 2) As Range
  4.     Sheets("2006_1").Range("B:O").Clear
  5.     For Each e In Sheets("2006_1").Range("a:a").SpecialCells(xlCellTypeConstants)
  6.         If Trim(e) <> "" Then   '排除有輸入空白字串的儲存格
  7.             'Trim(e) -- LTrim、RTrim 與 Trim 函數    傳回一個沒有前頭空白 (LTrim)、後面空白 (RTrim) 或前後均無空白的Variant (String)，其中所含為給定的字串。
  8.             Set Rng(1) = Sheets("Return").Range("a:a").Find(e, lookat:=xlPart)
  9.             If Not Rng(1) Is Nothing Then
  10.                 Set Rng(2) = Rng(1).CurrentRegion.Columns(1).Find("2005", lookat:=xlWhole)
  11.                 If Not Rng(2) Is Nothing Then e.Offset(, 1).Resize(, 14) = Rng(2).Resize(, 14).Value
  12.             End If
  13.         End If
  14.     Next
  15. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 小事不做、大事難成。
12
返回列表 上一主題