Sub IVDINI(A)



'ファイルの指定行を読込 

    Dim I       As Long

    Dim Fso     As New FileSystemObject

    'Microsoft Scripting Runtime　に参照設定 

    Dim FsoTS   As TextStream

    

    Dim SCA As String

    Dim SEL As String

    Dim SCAM As Long

    Dim SELM As Long

    

    Dim TEXT1 As String

    Dim N As Long

    Dim M As Long

    Dim I2 As Long

    Dim e As Long

    

    TEXT1 = ""

    myLine = CLng(Text2)

    Set FsoTS = Fso.OpenTextFile("C:\Users\Y2\Desktop\IVD_Sequences.txt")

    

     N = 0

     M = 0

     e = 0

   While e <> 1

    If FsoTS.AtEndOfStream = False Then

        M = M + 1

        TEXT1 = FsoTS.ReadLine

      If Left(TEXT1, 1) <> "#" Then

         N = N + 1

         ReDim Preserve SCA1(N)

         ReDim Preserve SCA2(N)

         ReDim Preserve SEL1(N)

         ReDim Preserve SEL2(N)

        

         SCA = SPP(TEXT1, 0, " ")

         SEL = SPP(SPP(TEXT1, 0, ";"), 1, " ")

         

         SCAM = Application.Hex2Dec(SCA)

         SELM = Application.Hex2Dec(SEL) - 917760

         

         SCA1(N) = SCA

         SCA2(N) = SCAM

         SEL1(N) = SEL

         SEL2(N) = SELM

        

        Else

         End If

       Else

        e = 1

    End If

    Wend

    FsoTS.Close

    Set FsoTS = Nothing

End Sub

Function IVD(SCATEST As Long, SELTEST As Long) As String

    Dim N As Long

    Dim M As Long

    Dim I2 As Long

    Dim e As Long

    

    N = UBound(SCA1())

    

    For I = 1 To N

     If SCA2(I) = SCATEST Then

      For I2 = I To N

       If (SCA2(I2) = SCATEST) * (SEL2(I2) = SELTEST) Then

       IVD = "有"

       I2 = N

       I = N

         Exit For

       Else

        IVD = "偽"

        End If

      Next

     Else

      IVD = "偽"

     End If

    Next

End Function

Function SPP(w As String, N As Long, SEP As String)

'http://www.eurus.dti.ne.jp/~yoneyama/Excel/vba/function/vba_string2.html 

 Dim S As Variant

 Dim WW As String

 S = Split(w, SEP)

 WW = S(N)

 SPP = WW

End Function

Function I異体字4(A, b, c, d)

 I異体字4 = ChrW(A) & ChrW(b) & ChrW(c) & ChrW(&HDD00 + d) '異体字連結 

End Function

Function uni2(A, b)

 uni2 = ChrW(A) & ChrW(b)

End Function

Function uni3(A, b, c)

 uni3 = ChrW(A) & ChrW(b) & ChrW(c)

End Function

Function uni4(A, b, c, d)

 uni4 = ChrW(A) & ChrW(b) & ChrW(c) & ChrW(d)

End Function

Function uni5(A, b, c, d, e)

 uni5 = ChrW(A) & ChrW(b) &ChrW(c) & ChrW(d) & ChrW(e)

End Function