標題: [發問] 如何用excel的巨集寫一個撈資料至另一個工作表，求解 [打印本頁]

---

作者: wantknow55    時間: 2013-3-24 18:44     標題: 如何用excel的巨集寫一個撈資料至另一個工作表，求解

現在有一個excel檔裡面有sheet1、sheet2，兩個工作表
sheet1的內容，想用一個Inputbox於輸入sheet1的編號後將該編號之同一列全部
複製或撈至sheet2，每次撈完皆會自動換列，求解。
[attach]14435[/attach]  ←此為sheet1之內容
[attach]14436[/attach]
[attach]14437[/attach]
求專家解，拜託了orz

---

作者: kimbal    時間: 2013-3-25 01:18

1. Sub test()
   
2.     Dim strID As String
   
3.     Dim intSheet1RowCnt
   
4.     Dim intSheet1RowCnter
   
5.     Dim rngSheet1Target
   
6.     Dim intSheet2RowCnt
   
7.     strID = InputBox("輸入編號")
   
8.     intSheet1RowCnt = Sheets("Sheet1").Range("A1").End(xlDown).Row
   
9.     For intSheet1RowCnter = 2 To intSheet1RowCnt
   
10.         If Sheets("Sheet1").Range("A1").Offset(intSheet1RowCnter, 2) = strID Then
    
11.             Set rngSheet1Target = Sheets("Sheet1").Range("A1").Offset(intSheet1RowCnter)
    
12.             With Sheets("Sheet2")
    
13.                 intSheet2RowCnt = .Range("A65536").End(xlUp).Row + 1
    
14.                 .Cells(intSheet2RowCnt, 1) = rngSheet1Target
    
15.                 .Cells(intSheet2RowCnt, 2) = rngSheet1Target.Offset(0, 1)
    
16.                 .Cells(intSheet2RowCnt, 3) = rngSheet1Target.Offset(0, 2)
    
17.             End With
    
18.         End If
    
19.     Next
    
20. End Sub

複製代碼

---

作者: GBKEE    時間: 2013-3-25 08:57

回復 1# wantknow55

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim BoxRow As Variant, BoxWord As Variant
   
4.     BoxWord = Application.InputBox("輸入編號", Type:=3)
   
5.     If BoxWord = False Then Exit Sub
   
6.     BoxRow = Application.Match(BoxWord, Sheets("Sheet1").Columns(3), 0)
   
7.     'Match函數傳回在Sheets("Sheet1").Columns(3)中第一個=編號的位置號數
   
8.     If IsNumeric(BoxRow) Then  'Match函數有找到傳回數字,反之傳回錯誤值
   
9.         With Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1)
   
10.            .Resize(, 3) = Sheets("Sheet1").Cells(BoxRow, 1).Resize(, 3).Value
    
11.         End With
    
12.     Else
    
13.         MsgBox BoxWord & "  編號找不到 !!"
    
14.     End If
    
15. End Sub

複製代碼

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)