[µo°Ý] ½Ð°Ý¦p¦ó¥Îvba¨Ó±N¼Ò²Õ©Î¥N½X¼g¤J¥t¤@­Óexcel

starry1314

¦]¬°Àɮ׻ݭn§ó·s¦ý¦³¤W¤d­ÓÀÉ®× Åܦ¨­n¤@¤@¥´¶}¶×¤J¼Ò²Õ...
http://blog.xuite.net/crdotlin/excel/7633898-%E7%94%A8VBA%E4%BE%86%E7%94%A2%E7%94%9FVBA
¥u§ä¨ì¤@­Ó¦ý¬OÀɮפw¥¢®Ä

Scott090

¦^´_ 1# starry1314


    °²¦p³Q³B²zªºÀɮפº®e®æ¦¡¬O¤@­Pªº¡A
¬°¤°»ò¤£¯à¥Î¥u¦³¦³µ{¦¡¼Ò²Õªº¤@­Ó¤u§@ï¨Ó³B²z¨ä¥L¤W¤d­ÓÀɮסA¦Ó¥²¶·§âµ{¦¡«þ¨©©Î²¾¸m¨ì¨ä¥LÀÉ®× ?

³o¬OºÃ°Ý¤]¬O«Øij¡A¦]¬°¤£ª¾§Aªº­ì©l¥Î·N

starry1314

¦^´_ 2# Scott090

¦]¬°·íªì³]­p®É³]·Q¤£¥þ,µLªkº¡¨¬·Q­nªº¸ê®Æ,¬G¶·°µ­×¥¿.....¦ý¦ÑÁó³s©¹¦~¸ê®Æ¤]­n´N¥²¶·¤@­Ó¤@­Ó¥h¶}¨Ó´¡¤Jµ{¦¡½X
¥B¦]¬°»Ý­nÅý¨C­ÓÀÉ®×°µ§¹­×§ï«á·|§Y®É§ó·s­×§ï«áªº¸ê®Æ¦Üaceess¸Ì­±,
¬G¨C­ÓÀÉ®×¥²¶·³£­n¦³¤W¶Çªºµ{¦¡¦b¤º¤~¯à¦bÀx¦sªº®É­Ô§ó·s¸ê®Æ

lpk187

¦^´_ 3# starry1314

µ¹§A¤@­Ó¤j·§ªº¼Ò«¬¡A¨ä¥Lªº½Ð¦Û¦æ­×§ï¤º®e
¥H¤U¥N½X¥²¶·¦b¤u¨ã>>³]©w¤Þ¥Î¶µ¥Ø¤¤¡A¤Þ¥Î Microsoft Visual Basic For Application Extensibility 5.3<<³o­Ó­n¤Ä¿ï

1. Option Explicit
   
2. Public Sub ex()
   
3.     Dim s As String
   
4.     Dim VBCom As Object
   
5.     Dim VBP
   
6.     On Error Resume Next
   
7.      Do
   
8.         Err = 0
   
9.         Set VBP = ActiveWorkbook.VBProject
   
10.         If Err <> 0 Then
    
11.             If MsgBox("¥¨¶°¦w¥þ³]¸m¸m¤£¤¹³\¥N¥N½X¶i¦æ¦æ¾Þ§@¡C" & vbCrLf & vbCrLf & "½Ð±N«H¥ô¤¤¤ß¤º«H¥ô¦s¨úVBA±M®×ª«¥ó¼Ò«¬¤Ä¿ï", vbCritical + vbYesNo, "¥¨¶°³]©w") = vbYes Then
    
12.                 With Application
    
13.                     .SendKeys "t"
    
14.                     .CommandBars.FindControl(ID:=3627).Execute
    
15.                 End With
    
16.             Else
    
17.                 Exit Sub
    
18.             End If
    
19.         End If
    
20.     Loop Until Err = 0
    
21.     On Error GoTo 0
    
22.     s = "sub ¦X­p()" & vbCrLf '
    
23.     s = s & "    Dim rng1 As Range, rng2 As Range" & vbCrLf
    
24.     s = s & "    Dim ¤é´Á As Date" & vbCrLf
    
25.     s = s & "    With Sheets(1)" & vbCrLf '
    
26.     s = s & "        ¸¹½X = .Cells(3, 18)" & vbCrLf
    
27.     s = s & "        ¤é´Á = .Cells(2, 19)" & vbCrLf
    
28.     s = s & "        Set rng1 = .Columns(1).Find(¸¹½X)" & vbCrLf
    
29.     s = s & "        Set rng2 = .Rows(1).Find(¤é´Á, LookIn:=xlValues)" & vbCrLf
    
30.     s = s & "        .Cells(3, 19) = .Cells(rng1.Row, rng2.Column).Value" & vbCrLf
    
31.     s = s & "    End With" & vbCrLf '
    
32.     s = s & "End Sub"
    
33.     Set VBCom = ThisWorkbook.VBProject.VBComponents.Add(1) '´¡¤J¼Ò²Õ
    
34.     VBCom.Name = "¼Ò²Õ1" 'Åܧó¼Ò²Õ¦WºÙ
    
35.     With VBCom.CodeModule
    
36.         .InsertLines .CountOfLines + 1, s '¼g¤J¥N½X
    
37.     End With
    
38. End Sub

½Æ»s¥N½X

lpk187

¦^´_ 3# starry1314

Option Explicit
Public Sub ex()
    Dim s As String
    Dim VBCom As Object
    Dim VBP
    On Error Resume Next
     Do
        Err = 0
        Set VBP = ActiveWorkbook.VBProject
        If Err <> 0 Then
            If MsgBox("¥¨¶°¦w¥þ³]¸m¸m¤£¤¹³\¥N¥N½X¶i¦æ¦æ¾Þ§@¡C" & vbCrLf & vbCrLf & "½Ð±N«H¥ô¤¤¤ß¤º«H¥ô¦s¨úVBA±M®×ª«¥ó¼Ò«¬¤Ä¿ï", vbCritical + vbYesNo, "¥¨¶°³]©w") = vbYes Then
                With Application
                    .SendKeys "t"
                    .CommandBars.FindControl(ID:=3627).Execute
                End With
            Else
                Exit Sub
            End If
        End If
    Loop Until Err = 0
    On Error GoTo 0
    s = "sub ¦X­p()" & vbCrLf '
    s = s & "    Dim rng1 As Range, rng2 As Range" & vbCrLf
    s = s & "    Dim ¤é´Á As Date" & vbCrLf
    s = s & "    With Sheets(1)" & vbCrLf '
    s = s & "        ¸¹½X = .Cells(3, 18)" & vbCrLf
    s = s & "        ¤é´Á = .Cells(2, 19)" & vbCrLf
    s = s & "        Set rng1 = .Columns(1).Find(¸¹½X)" & vbCrLf
    s = s & "        Set rng2 = .Rows(1).Find(¤é´Á, LookIn:=xlValues)" & vbCrLf
    s = s & "        .Cells(3, 19) = .Cells(rng1.Row, rng2.Column).Value" & vbCrLf
    s = s & "    End With" & vbCrLf '
    s = s & "End Sub"
    Set VBCom = ThisWorkbook.VBProject.VBComponents.Add(1) '´¡¤J¼Ò²Õ
    VBCom.Name = "¼Ò²Õ1" 'Åܧó¼Ò²Õ¦WºÙ
    With VBCom.CodeModule
        .InsertLines .CountOfLines + 1, s '¼g¤J¥N½X
    End With
End Sub