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

[µo°Ý] ¦p¦ó¤ñ¹ï¥XA/BÄæ­«½Æ¤Î¤í¯Ê¤§¼Æ­È

[µo°Ý] ¦p¦ó¤ñ¹ï¥XA/BÄæ­«½Æ¤Î¤í¯Ê¤§¼Æ­È

¥»©«³Ì«á¥Ñ loyyee ©ó 2011-10-15 09:11 ½s¿è

¼Æ­È¤ñ¹ï.rar (9.97 KB) ½Ð°Ý¦p¦ó¤ñ¹ï¥XA/BÄæ­«½Æ¤Î¤í¯Ê¤§¼Æ­È?

AÄæ            BÄæ
A0001        A0001
A0002        A0002
A0003        A0003
A0003        A0004
A0005        A0004
A0007        A0006

AÄæ­«½Æ¼Æ­È:A0003
AÄæ¤í¯Ê¼Æ­È:A0004.A0006
BÄæ­«½Æ¼Æ­È:A0004
BÄæ¤í¯Ê¼Æ­È:A0005.A0007

¦^´_ 1# loyyee
¼Æ­È¤ñ¹ï-Ans.zip (29.08 KB)

TOP

¦^´_ 2# luhpro

·PÁ¸ѵª¡A¦pªGA/BÄæ¼Æ¶q¤£¬Ûµ¥®É·|¥X²{¿ù»~¡A½Ð°Ý¸Ó¦p¦ó­×§ï? ¼Æ­È¤ñ¹ï-Ans.rar (20.8 KB)

TOP

¦^´_ 3# loyyee
­è­èµo²{­ìµ{¦¡¦³¨â­Ó¦a¤è¦³¿ù»~¤§«e¨S¦³ª`·N¨ì :
  If .Cells(lTarRow(iLack) - 1, iLack) <> "A" & Right("0000" & lCount, 4) Then
»P
  .Value = "A" & Right("0000" & lCount, 4)
lCount ­n§ï¦¨ lJ

­×§ïµ{¦¡¦p¤U:
¼Æ­È¤ñ¹ï-Ans2.zip (28.63 KB)

TOP

¦^´_ 4# luhpro

·PÁ­קïµ{¦¡¥i¥H¥Î¤F¡A­nªáÂI®É¶¡¬ã¨s¥¨¶°¡C

TOP

¥»©«³Ì«á¥Ñ oobird ©ó 2011-10-8 11:18 ½s¿è
  1. Private Sub cbCheckData_Click()
  2.     Dim a As Range, b As Range, e%, f%, r%
  3.     Set a = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
  4.     Set b = Range(Cells(1, 2), Cells(1, 2).End(xlDown))
  5.     e = 7: f = 7
  6.     For r = 1 To a.Count
  7.         If Application.CountIf(b, a(r)) = 0 And [j:j].Find(a(r), , , 1) Is Nothing Then [j65536].End(xlUp).Offset(1, 0) = a(r)
  8.         If Application.CountIf(a, a(r)) > 1 And [e:e].Find(a(r), , , 1) Is Nothing Then Cells(e, 5) = a(r): e = e + 1
  9.     Next
  10.     For r = 1 To b.Count
  11.         If Application.CountIf(a, b(r)) = 0 And [i:i].Find(b(r), , , 1) Is Nothing Then [i65536].End(xlUp).Offset(1, 0) = b(r)
  12.         If Application.CountIf(b, b(r)) > 1 And [f:f].Find(b(r), , , 1) Is Nothing Then Cells(f, 6) = b(r): f = f + 1
  13.     Next
  14. End Sub
½Æ»s¥N½X

TOP

¦^´_ 6# oobird

·PÁª©¥D¨ó§U­×§ï¡C

TOP

§A¦n¡G
   
     §Aªº´£°ÝÅý§Ú¤]¦³¾Ç²ßªº¾÷·|¡C
ÁÂÁ§A¡I
½Ð¸Õ¸Õ¤U¦C¬O§_¥i¾A¥Î¡C
Sub aa()
   
    Dim mSht As Worksheet
    Dim mRng1 As Range, mRng2 As Range, E As Range   
    Dim mDic1 As Object
    Dim mDic2 As Object   
    Dim mData1(), mData2()
    Dim s1%, s2%
    Dim key1, key2
   
    Set mDic1 = CreateObject("scripting.dictionary")
    Set mDic2 = CreateObject("scripting.dictionary")
   
    Set mSht = Worksheets(1)
    With mSht
        Set mRng1 = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
        Set mRng2 = .Range("b1", .Range("b" & .Rows.Count).End(xlUp))
      
        For Each E In mRng1
            If Not mDic1.Exists(E.Value) Then
                mDic1.Add (E.Value), E.Value
            Else
                ReDim Preserve mData1(s1)
                mData1(s1) = E.Value
                s1 = s1 + 1
            End If
        Next        
               
        For Each E In mRng2
            If Not mDic2.Exists(E.Value) Then
                mDic2.Add (E.Value), E.Value
            Else
                ReDim Preserve mData2(s2)
                mData2(s2) = E.Value
                s2 = s2 + 1
            End If
        Next
        .Range("e6") = "­«½Æ¼Æ­È"
        .Range("e6:f6").Merge
        .Range("e7").Resize(s1) = Application.Transpose(mData1)
        .Range("f7").Resize(s2) = Application.Transpose(mData2)
        'mKey2 = mDic2.Keys
        'mItem2 = mDic2.Items
        
        Erase mData1
        Erase mData2
        s1 = 0
        s2 = 0
        
        For Each key1 In mDic1.Keys
            If key1 <> mDic2(key1) Then
                ReDim Preserve mData1(s1)
                mData1(s1) = key1
                s1 = s1 + 1
            End If
        Next
        
        For Each key2 In mDic2.Keys
            If key2 <> mDic1(key2) Then
                ReDim Preserve mData2(s2)
                mData2(s2) = key2
                s2 = s2 + 1
            End If
        Next
        
        .Range("i1") = "AÄæ¯Ê¤§¼Æ­È"
        .Range("j1") = "BÄæ¯Ê¤§¼Æ­È"
        
        .Range("i2").Resize(s1) = Application.Transpose(mData1)
        .Range("j2").Resize(s2) = Application.Transpose(mData2)        
            
    End With
   
    Set mDic1 = Nothing
    Set mDic2 = Nothing
    Set mRng1 = Nothing
    Set mRng2 = Nothing   
   
End Sub

TOP

¦^´_ 8# dechiuan999

·PÁ±z¼ö¤ß«ü¾É¥¨¶°¥i¥H¥Î¡A¦ý¬O¦³¤@¨Ç°ÝÃD:
1.¹J¨ì¼Æ­È¤¤¶¡¦³³sÄòªÅ¥Õ®É¡AªÅ¥Õ¤]·|³Q§ì¨ì"­«½Æ¼Æ­È"¡C
2.³sÄò­«½Æ¼Æ­È·|³£³Q§ì¥X¡A©êºp³oÂI§Ú·íªì¨S»¡²M·¡­«½Æ¼Æ­È§Ú¥u­n§ì¤@¦¸´N¦n¡C

¼Æ­È¤ñ¹ï-Ans2.rar (27.57 KB)

TOP

¥»©«³Ì«á¥Ñ dechiuan999 ©ó 2011-10-9 09:08 ½s¿è

§A¦n¡G

   ½Ð¦A¸Õ¸Õ¦p¤U¡G
Sub aa()
   
    Dim mSht As Worksheet
    Dim mRng1 As Range, mRng2 As Range, E As Range
    Dim mDic1 As Object
    Dim mDic2 As Object
    Dim mData1(), mData2()
    Dim s%, s1%, s2%
   
    Set mDic1 = CreateObject("scripting.dictionary")
    Set mDic2 = CreateObject("scripting.dictionary")        
    Set mSht = Worksheets(1)
    With mSht
        Set mRng1 = .Range("a1", .Range("a" & .Rows.Count).End(xlUp))
        Set mRng2 = .Range("b1", .Range("b" & .Rows.Count).End(xlUp))
      
        For Each E In mRng1
            If E.Value <> "" Then
                mDic1(E.Value) = mDic1(E.Value) + 1
            End If
        Next
      
        
        For Each key1 In mDic1.Keys
            If mDic1(key1) > 1 Then
                ReDim Preserve mData1(s1)
                mData1(s1) = key1
                s1 = s1 + 1
            End If
        Next
               
        For Each E In mRng2
            If E.Value <> "" Then
                mDic2(E.Value) = mDic2(E.Value) + 1
            End If
        Next
        
        For Each key2 In mDic2.Keys
            If mDic2(key2) > 1 Then
                ReDim Preserve mData2(s2)
                mData2(s2) = key2
                s2 = s2 + 1
            End If
        Next
        
               
        .Range("e6") = "­«½Æ¼Æ­È"
        .Range("e6:f6").Merge
        .Range("e7").Resize(s1) = Application.Transpose(mData1)
        .Range("f7").Resize(s2) = Application.Transpose(mData2)
      
        
        Erase mData1
        Erase mData2
        s1 = 0
        s2 = 0
        
        For Each key1 In mDic1.Keys
            If Not mDic2.Exists(key1) Then
                ReDim Preserve mData1(s1)
                mData1(s1) = key1
                s1 = s1 + 1
            End If
        Next
        
        For Each key2 In mDic2.Keys
            If Not mDic1.Exists(key2) Then
                ReDim Preserve mData2(s2)
                mData2(s2) = key2
                s2 = s2 + 1
            End If
        Next
        
        .Range("i1") = "AÄæ¯Ê¤§¼Æ­È"
        .Range("j1") = "BÄæ¯Ê¤§¼Æ­È"
        
        .Range("i2").Resize(s1) = Application.Transpose(mData1)
        .Range("j2").Resize(s2) = Application.Transpose(mData2)
            
    End With
   
    Set mDic1 = Nothing
    Set mDic2 = Nothing
    Set mRng1 = Nothing
    Set mRng2 = Nothing
   
End Sub

TOP

        ÀR«ä¦Û¦b : ­n¥Î¤ß¡A¤£­n¾Þ¤ß¡B·Ð¤ß¡C
ªð¦^¦Cªí ¤W¤@¥DÃD