Hsieh

1. Sub test()
   
2.     Dim mtstr As String, Wb As Workbook
   
3.     On Error Resume Next
   
4.     myStr = "¿ï¨ú¸ê®ÆOK«á«ö½T©wÁä"
   
5.     Set k = Application.InputBox(myStr, Type:=8)  'data½d³ò
   
6.     If Err Then Exit Sub
   
7.     Set Wb = Workbooks.Add    '¶}±Ò·s¬¡­¶Ã¯
   
8.     ThisWorkbook.Activate
   
9.     k.Copy Wb.ActiveSheet.[A3]
   
10.     Set k = Nothing
    
11.     Do Until Err.Number <> 0
    
12.       Set k = Application.InputBox(myStr, Type:=8) 'data½d³ò
    
13.       k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '«ü©wÀx¦s®æ ¶K¤W¸ê®Æ
    
14.       Set k = Nothing
    
15.     Loop
    
16. End Sub

½Æ»s¥N½X

Hsieh

1. Sub test()
   
2.     Dim mtstr As String, Wb As Workbook
   
3.     On Error Resume Next
   
4.     myStr = "¿ï¨ú¸ê®ÆOK«á«ö½T©wÁä"
   
5.     Set k = Application.InputBox(myStr, Type:=8)  'data½d³ò
   
6.     If Err Then Exit Sub
   
7.     Set Wb = Workbooks.Add    '¶}±Ò·s¬¡­¶Ã¯
   
8.     ThisWorkbook.Activate
   
9.     k.Copy Wb.ActiveSheet.[A3]
   
10.     Set k = Nothing
    
11.     Response = MsgBox("¬O§_Ä~Äò", vbYesNo)
    
12.     Do Until Response <> vbYes
    
13.       Set k = Application.InputBox(myStr, Type:=8) 'data½d³ò
    
14.       k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '«ü©wÀx¦s®æ ¶K¤W¸ê®Æ
    
15.       Set k = Nothing
    
16.       Response = MsgBox("¬O§_Ä~Äò", vbYesNo)
    
17.     Loop
    
18. End Sub

½Æ»s¥N½X

Hsieh

·í·sªº¬¡­¶Ã¯¶}±Ò®É¡A§@¥Î¤¤¬¡­¶Ã¯·|«ü¦V¸Ó·s¼Wªº¬¡­¶Ã¯
ThisWorkbook.Activate
½T«O§@¥Î¤¤¬¡­¶Ã¯·|¬Oµ{¦¡½X©Ò¦b¤§¬¡­¶Ã¯
¦¹®É·s¬¡­¶Ã¯¤´µM¬OÅã¥Üªº¡A¥u¬OÅã¥Ü¦b¤U¤@¼hµøµ¡

Set k = Nothing
¦b³oÃä¬O¥²¶·ªº¡A·í¹ï¸Ü®Ø¿ï¾Ü°Ê§@·|³y¦¨µ{¦¡¥X¿ù®É
¦]«e­±ªºOn Error Resume Next·|Åýµ{§ÇÄ~Äò°õ¦æ¡A­Y¤£ÄÀ©ñkª«¥ó
µ{¦¡¦bµ²§ô®É¥i¯à·|¦h¶K¤@¦¸¥¼ÄÀ©ñªºkª«¥ó

Hsieh

¦^´_ 8# linsurvey2005

¤w¸g³Q§A¥´±Ñ¤F
³Q§Aªº»¡©ú·dªº¸£³U¥´µ²¤F
­º¥ý§A¥u­n½T©w§A­nÂI¿ï¬O­þ­ÓÀÉ®×?
ÂI¿ï«á½Æ»s¨ì­þ­ÓÀÉ®×?
³Ì²³æ´N¬O§â³o¨ÇÀɮצb¶}±Ò®É¥ÎÅܼƨÓÀx¦s´N¯à¦b«áÄò°Ê§@«ü©w¨ì¥¿½TÀÉ®×
¦A¥Î°j°é¨Ó¶}±ÒÂI¿ïµ¡®æ(inputbox)¡A»PÄ~Äò»P§_ªº¹ï¸Ü(msgbox)
²M·¡¤F¸Ñ§A·Q­nªº°Ê§@¶¶§Ç´N¯à§¹¦¨  
¦]¬°¤§«eªº»yªk¤w¸g¥]§t¤F¶}±Ò·sÀÉ¡A±NÀɮ׫ü©wµ¹ª«¥óÅܼơA  °j°éÂI¿ï½Æ»s

Hsieh

¦^´_ 10# linsurvey2005

¸Õ¸Õ¬Ý³o¼Ë¬O¤£¬O§A­nªº

1. Sub Selection_Copy()
   
2. Dim fs$, SRng, SourceWb As Workbook
   
3. fs = Application.GetOpenFilename("Excel ÀÉ®×(*.xls),*.xls")
   
4. Set SourceWb = Workbooks.Open(fs)
   
5. k = Application.InputBox("½Ð¿ï¨ú±ý½Æ»sªº½d³ò", , , , , , , 8)
   
6. If TypeName(k) = "Boolean" Then SourceWb.Close 0: Exit Sub
   
7. Set nwb = Workbooks.Add
   
8. With nwb.Sheets(1)
   
9. .Activate
   
10. r = Application.Max(12, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
    
11. If IsArray(k) Then
    
12. .Cells(r, 1).Resize(UBound(k, 1), UBound(k, 2)) = k
    
13. Else
    
14. .Cells(r, 1) = k
    
15. End If
    
16. yn = MsgBox("¬O§_Ä~Äò", vbYesNo): GoTo 10
    
17. Do Until yn <> 6 Or TypeName(k) = "Boolean"
    
18. r = Application.Max(12, .Cells(.Rows.Count, 1).End(xlUp).Row + 1)
    
19. If IsArray(k) Then
    
20. .Cells(r, 1).Resize(UBound(k, 1), UBound(k, 2)) = k
    
21. Else
    
22. .Cells(r, 1) = k
    
23. End If
    
24. yn = MsgBox("¬O§_Ä~Äò", vbYesNo)
    
25. 10
    
26. If yn = 6 Then SourceWb.Activate: k = Application.InputBox("½Ð¿ï¨ú±ý½Æ»sªº½d³ò", , , , , , , 8)
    
27. Loop
    
28. nwb.Activate
    
29. DoEvents
    
30. myfilename = Format(Date, "yymmdd") & "-Tilt-PDA.xls"
    
31. Application.SendKeys myfilename, True
    
32. sf = Application.GetSaveAsFilename("E:\")
    
33. If sf <> False Then nwb.SaveAs sf
    
34. SourceWb.Close 0
    
35. End With
    
36. End Sub

½Æ»s¥N½X