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