[µo°Ý] ¨D§U«Ø¥ß°j°éÀ³¥Î

linsurvey2005

¥H¤Uµ{¦¡½X¬O§Ú°õ¦æ³æ¦¸ªº¤èªk¬O¥¿±`°õ¦æªº
¥i¬O·í¸ê®Æ½d³ò¦b¤£¦Psheet´N³Â·Ð¤F
¦]¬°§Ú«ü©w¤F¦ì§}Range("A3").Selectµ¹¥L
·Q­nÅý¸ê®Æ¦³¤@ª½°é¿ï©¹«á¼W¥[
¤@ª½¨ì«ö¨ú®øµM«áÄ~Äò°õ¦æ«á­±µ{¦¡
­Y¯à«ü¥¿µ{¦¡ªº½X½s¤è¦¡ §Ú·|§ó°ª¿³~¦h¾Ç¤@©Û·|§ó¦nºÎı~^.^

Sub test()
    Dim mtstr As String
    myStr = "¿ï¨ú¸ê®ÆOK«á«ö½T©wÁä"
    On Error Resume Next
    Set k = Application.InputBox(myStr, Type:=8)  'data½d³ò
    p = k.Copy
    Workbooks.Add     '¶}±Ò·s¬¡­¶Ã¯
    Range("A3").Select '«ü©wÀx¦s®æ
    ActiveSheet.Paste  '¶K¤W¸ê®Æ
    If Err Then
          Err.Clear
    Exit Sub
    End If
End Sub

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

linsurvey2005

ÁÂÁ¦Ѯv¦^´_,¦A¶i¤@¨B½Ð±Ð¦Ñ®v
§Ú³o¼Ë¼W¥[¦æ¦C¤W¥h·|¼vÅTµ{¦¡ªº¹B§@¶Ü?(§Ú¶]°_¨ÓÁÙ¦n¥u¬O·Q¤F¸ÑÆ[©À)
ÁÙ¦³§Ú¥i¥H¦b²Ä¤@¦¸¿ï¨ú¸ê®Æ®É´N¤@°_Åã¥Ü"¦pªG­nÄ~Äò¿ï¨ú½Ð«ö[Ä~Äò]Áä"¶Ü?
·Pı§Ú³o¼Ë¦n¹³¤S¦h¤@¦¸°Ê§@
½Ð¦Ñ®vÀ°§Ú«ü¥¿

    Do Until Err.Number <> 0
     Dim Msg1, Style, Response, MyString
      Style = vbYesNo
      Msg1 = "¬O / §_ Ä~Äò¿ï¨ú¸ê®Æ"
      Response = MsgBox(Msg1, Style)
        If Response = vbYes Then    ' ­Y¨Ï¥ÎªÌ«ö¤U [¬O]¡C
      Set k = Application.InputBox(myStr, Type:=8) 'data½d³ò
      k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '«ü©wÀx¦s®æ ¶K¤W¸ê®Æ
      Set k = Nothing
            Else
             Exit Do    ' ²£¥Í¬Û¹ï¦^À³¡C
        End If
      Loop

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

linsurvey2005

·PÁ¦Ѯvªº¦A¤T¦^ÂÐ
½Ð±Ð¥H¤U´X¦æ¬O¤£¬OÅýª«¥ó¥Ñ"K"µe­±(Åã¥Üª¬ºA)±a¥X¸ê®Æ«á
´¡¤J·s¬¡­¶Ã¯(ÁôÂꬺA),³o¼Ë¬O´£°ª§@·~®Ä²vªº¤@ºØ¶Ü?
¥t¥~¹ï"K"ª«¥óÄÀ©ñ,¬O¤£¬O¨¾¤î¸ê®Æ¦h ¹q¸£·|¥d¥dªº.
¤£¦n·N«ä°ÝÃD¤ñ¤s°ª~^.^
Set Wb = Workbooks.Add    '¶}±Ò·s¬¡­¶Ã¯
ThisWorkbook.Activate
k.Copy Wb.ActiveSheet.[A3]
Set k = Nothing

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ª«¥ó

linsurvey2005

·PÁ¦Ѯv¤£§[«ü¾É,¥¦¤s¤§ªk
§Ú¦A¦¸¼W¥[¤F¶}Àɦæ¦C
Ä~Äò¿ï¨ú¸ê®Æ´NÅã¥Ü¨ì¿ï¨úªº¬¡­¶Ã¯
¦pªGµ²§ô¿ï¨ú´NÅã¥Ü¨ì·sªº¬¡­¶Ã¯
¦]¥¨¶°¬O¦b¥t¥~¤@­ÓExcelÀɮ׫إß(µ{¦¡ÀÉ.xls)
³Ì¥D­n¬O§Æ±æ¹B§@®É¤£­n½s¿è¨ì(µ{¦¡ÀÉ.xls)
¦ý¬O·s¼W³¡¤À´N¬O¤£·|Åã¥Ü¨ì"·s¬¡­¶Ã¯"
½Ð¦Ñ®vÀ°¦£«ü¾É

Sub testopen()
    F = Application.GetOpenFilename("Excel ÀÉ®×(*.xls),*.xls")
    If F = "False" Then Exit Sub
        Workbooks.Open filename:=F
            y = ActiveWorkbook.Name        
    Dim mtstr As String, Wb As Workbook
    On Error Resume Next
        myStr = "¿ï¨ú¸ê®ÆOK«á«ö½T©wÁä"
    Set k = Application.InputBox(myStr, Type:=8)  'data½d³ò
    If Err Then Exit Sub
        Set Wb = Workbooks.Add    '¶}±Ò·s¬¡­¶Ã¯
            ThisWorkbook.Activate
                Wb = ActiveWorkbook.Name            
            k.Copy Wb.ActiveSheet.[A3]
        Set k = Nothing
        Response = MsgBox("¬O / §_Ä~Äò¿ï¨ú", vbYesNo)
    Do Until Response <> vbYes
Windows(y).Activate        
       Set k = Application.InputBox(myStr, Type:=8) 'data½d³ò
            k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '«ü©wÀx¦s®æ ¶K¤W¸ê®Æ
        Set k = Nothing
            Response = MsgBox("¬O / §_Ä~Äò¿ï¨ú", vbYesNo)
    Loop
   
    Application.DisplayAlerts = False
        Windows(y).Close
    Application.DisplayAlerts = True
    Application.ScreenUpdating = False
Windows(Wb).Activate  
.........
.......
....

linsurvey2005

¦Ñ®v¥i¥H¦A«ü¾É¤@¤U¹À?
¦n´Á«Ý¤º

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

linsurvey2005

©çÁÂ~§Úªº°ÝÃDÅÞ¿èµ²ºc¤£°÷¨ãÅé³y¦¨"¸£³U¥´µ²"~^.^
ÁÙ¬O§Úµ¹¦Ñ®v¬Ý¥þ³¡ªºµ{¦¡½X ³o¼Ë¤ñ¸û¤£·|µ§»~~^.^
Sub testall()
    F = Application.GetOpenFilename("Excel ÀÉ®×(*.xls),*.xls")
       If F = "False" Then Exit Sub
         Workbooks.Open filename:=F
            y = ActiveWorkbook.Name         
    Dim mtstr As String, Wb As Workbook
    On Error Resume Next
      myStr = "¿ï¨ú¸ê®ÆOK«á«ö½T©wÁä"
    Set k = Application.InputBox(myStr, Type:=8)  'data½d³ò
         If Err Then Exit Sub
           Set Wb = Workbooks.Add    '¶}±Ò·s¬¡­¶Ã¯
    ThisWorkbook.Activate
         k.Copy Wb.ActiveSheet.[A3]
           Set k = Nothing'ÄÀ©ñª«¥ó
              Response = MsgBox("¬O / §_Ä~Äò¿ï¨ú", vbYesNo)
    Do Until Response <> vbYes
        Windows(y).Activate'¦^¨ì­ì¿ï¨úÀÉ®×Ä~Äò¿ï¨ú
           Set k = Application.InputBox(myStr, Type:=8) 'data½d³ò
             k.Copy Wb.ActiveSheet.[A65536].End(xlUp).Offset(1, 0) '«ü©wÀx¦s®æ ¶K¤W¸ê®Æ
           Set k = Nothing'ÄÀ©ñª«¥ó
             Response = MsgBox("¬O / §_Ä~Äò¿ï¨ú", vbYesNo)
    Loop
   
    Application.DisplayAlerts = False'Ãö³¬°T®§Äæ   
       Windows(y).Close' Ãö³¬¿ï¨ú¸ê®ÆÀÉ®×
    Application.DisplayAlerts = True'¶}±Ò°T®§Äæ
   
   Application.ScreenUpdating = False
        Windows(Wb).Activate 'Åã¥Ü¨ì·s¬¡­¶Ã¯ÀÉ®×µe­±
        Windows("book1".xls).Activate   '¤W­±¨º¦æ¥i¥H¼g¦¨³o¼Ë¹À?  
Dim nX As Long, X As Long, I As Integer'¥H¤U¬O¦b·s¬¡­¶Ã¯°õ¦æ
    nX = [A65536].End(xlUp).Row
    For X = nX To 4 Step -1
      For I = 1 To 3
       Rows(X).Insert
      Next
    Next
    bb = (nX - 1) * 4 - 1
    cc = 65536
    Rows(bb & ":" & cc).Clear
    Columns("n") = Columns("n").Value'¥uÅã¥Üªí®æ¸ê®Æ
    Application.Dialogs(xlDialogSaveAs).Show (Format(Date, "yymmdd" & "-Tilt") & "-PDA" & ".xls")'¥t¦s·s¬¡­¶Ã¯ÀɦW
   Windows("µ{¦¡ÀÉ").Close'Ãö³¬¥¨¶°¼¶¼gÀÉ®×(¦]¬°§Ú¨Ï¥Î¥¨¶°¤p«ö¶s«ü©w¥¨¶°¨Ó±Ò°Ê)À³¸Ó¬O¦Ñ®v»¡ªº"µ{¦¡ÀÉ"¬Ò¦A¤U¼h°õ¦æ¤£­nÅã¥Üª¬ºA
End Sub
¥H¤W ³Â·Ð¦Ñ®vÀ°§Ú«ü¥¿~¾ÇµL¤îºÉ,¾i¥Í¥­©Ê~^.^