ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] §ó·s¶i«×¡A¨Ó·½¬°¦h­ÓÀÉ®×

[µo°Ý] §ó·s¶i«×¡A¨Ó·½¬°¦h­ÓÀÉ®×

¦³¤@CASE¡A¬O¥Ñ³\¦h³¡ªù¤@¦P¦X§@¡A­n­t³d¾ã¦X¦U³æ¦ìªº¶i«×¯uªº¬O«D±`ÂZ¤H¡A¥Ø«e³£¥Î¤@­Ó¤@­Ó½Æ»s¶K¤W¡A§ó·s³¡¤À¦A¦Û¦æ¼ÐÂŦr¡A¤£¯à°÷ª½±µ½Æ»s¾ã­ÓÀx¦s®æ¡A¦]¬°¤@­ÓÀx¦s®æ¦³¦h­Ó³æ¦ì¡A©Ò¥H¥u¯à¥I¨îÀx¦s®æ¤ºªº¤º®e¡A¦ý¬O´N·|Åܦ^­ì®æ¦¡¡A©Ò¥HÁÙ­n¦A¼Ð¤@¦¸ÂŦr¡A½Ð±Ð­n«ç»ò¼Ë¥i¥H¦Û°Ê§ì¨ú«á§ó·s




¦^´_ 1# 44754875


¤è«K¥i¥H´£¨Ñ¨Ó·½©M»Ý¨Dµ²ªGªºÀÉ®×´ú¸Õ¶Ü? ÁÂÁÂ

TOP

¦^´_ 2# samwang


    ¨Ó·½ÀÉ®×

TEST.rar (30.12 KB)

TOP

¦^´_ 3# 44754875


½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁ¡C
Sub test()
Dim WB, Arr, Brr, xD, Ar, a, a1, fc%, x%, fn$, n%, i&, j%, iPos%, iLen%, iPos1%
Application.ScreenUpdating = False: Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

Set xD = CreateObject("Scripting.Dictionary")
Brr = Sheets(1).Range([­ì©l!d1], [­ì©l!d65536].End(3))
With Sheets(2)
    If .FilterMode Then .ShowAllData
    .[d1].Resize(UBound(Brr)) = Brr
    .[d1].Resize(UBound(Brr)).Font.ColorIndex = 1
End With

With Application.FileDialog(msoFileDialogOpen)
    .InitialFileName = "D:\"
    .AllowMultiSelect = True
    .Show
    fc = .SelectedItems.Count
    If fc = 0 Then Exit Sub
    Tm = Timer
    For x = 1 To fc
        FPath = .SelectedItems(x)
        Set WB = Workbooks.Open(FPath)
        With Sheets(1)
            If .FilterMode Then .ShowAllData
            Arr = .Range("d1:d" & .[d65536].End(3).Row)
            For i = 2 To UBound(Arr)
                Ar = Split(Arr(i, 1), Chr(10))
                For j = 0 To UBound(Ar)
                    a = Split(Ar(j), ":")(0): a1 = Split(Ar(j), ":")(1): xD(a & "") = a1
                Next
            Next
        End With
        WB.Close
         
        For i = 2 To UBound(Brr)
            Ar = Split(Brr(i, 1), Chr(10))
            For j = 0 To UBound(Ar)
                a = Split(Ar(j), ":")(0): a1 = Split(Ar(j), ":")(1)
                If xD.Exists(a & "") Then
                    If a1 <> xD(a & "") Then
                        Sheets(2).Cells(i, 4) = Replace(Cells(i, 4), a1, "§ó·s-" & xD(a & ""))
                    End If
                End If
            Next
        Next
        xD.RemoveAll
    Next
End With

With Sheets(2)
    Arr = .Range("d1:d" & .[d65536].End(3).Row)
    For i = 2 To UBound(Arr)
        Ar = Split(Arr(i, 1), Chr(10))
        For j = 0 To UBound(Ar)
            a = Split(Ar(j), ":")(0): a1 = Split(Ar(j), ":")(1)
            iPos = InStr(a1, "§ó·s-"): iLen = Len(a1) + 5: iPos1 = InStr(Cells(i, 4), a)
            If iPos > 0 Then: .Cells(i, 4).Characters(iPos1, iLen).Font.ColorIndex = 3
        Next
    Next
End With
Application.ScreenUpdating = True: Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
MsgBox "°õ¦æ§¹¦¨" & Timer - Tm & " ¬í"
End Sub

TOP

¦^´_ 4# samwang
A¡BB¦U§O°õ¦æ³£¦¨¥\¡A¦ý¬OC ¥u¦³§ó·s¤@µ§¡A¥¿½T­n§ó·s¨âµ§¸ê®Æ
¥t¥~·í¦P®É¿ï¨úA¡BB¡BC°õ¦æ¥u¦³§ó·sB¡BCªº³¡¤À

TOP

¦^´_ 5# 44754875

§Ú´ú¸Õ«áµL»~¦pªþ¥ó¡A½Ð¦A½T»{¡AÁÂÁ¡C

¾ã¦X_0711.zip (23.92 KB)

TOP

¦^´_ 6# samwang
©êºp¦]¬°µLÅv­­¤U¸ü¡A½Ð°Ýµ{¦¡½X¦³­×§ï¶Ü

TOP

¦^´_ 6# samwang

TEST2.rar (40.72 KB)
§Ú½Æ»s¤W­±µ{¦¡´ú¸ÕªºÀÉ®×

TOP

¦^´_ 8# 44754875

§Úªºµ{¦¡½X¨S­×§ï¡A
­è­è¬Ý¤F§A¤W¶Ç´ú¸Õ¦³°ÝÃDªºÀɮפ~ª¾¹D°ÝÃD¦b©óµ{¦¡½X©ñ¿ù¦a¤è¡A
½Ð§âµ{¦¡½X©ñ¦b¤@¯ë¼Ò²Õ°õ¦æ´N¨S°ÝÃD¤F¡AÁÂÁ¡C

TOP

¦^´_ 9# samwang
¤Ó·PÁ¤F¡A¦¨¥\¤F

TOP

        ÀR«ä¦Û¦b : ¡i®É¶¡µLªk¾B¾×¡j©È®É¶¡®ø³u¡Aªá¤F³\¦h¤ß¦å¡A·QºÉ¦U¦¡¤èªk­n¾B¾×®É¶¡¡Aµ²ªG¬O¡G®ö¶O¤F§ó¦h®É¶¡¡A¥B¤@µL©Ò¦¨¡I
ªð¦^¦Cªí ¤W¤@¥DÃD