본문 바로가기

04번. IT 힌트얻기/▶ Excel

Excel with VB 3번째

Option Explicit

Sub searchDuplicate()

    Dim source_number As String
    Dim target_number As String
    Dim i As Integer
    Dim j As Integer
    Dim cnt As Integer
   
   
    Worksheets("DATA").Activate
   
    cnt = Range("a5").CurrentRegion.Rows.Count + 3
    Debug.Print cnt
   
    For i = 6 To cnt
        source_number = CStr(Cells(i, 5).Value)
       
        For j = i + 1 To cnt
            target_number = CStr(Cells(j, 5).Value)
           
            If source_number = target_number Then
               Range(Cells(i, 1), Cells(i, 8)).Interior.Color = RGB(255, 255, 0)
               Range(Cells(j, 1), Cells(j, 8)).Interior.Color = RGB(255, 255, 0)
            End If
           
        Next j
    Next i

End Sub

Sub searchDuplicateToCopy()

    Dim source_number As String
    Dim target_number As String
    Dim i As Integer
    Dim j As Integer
    Dim cnt As Integer
    Dim cntNew As Integer
   
   
    Worksheets("DATA").Activate
   
    cnt = Range("a5").CurrentRegion.Rows.Count + 3
    Debug.Print cnt
   
    For i = 6 To cnt
        source_number = CStr(Cells(i, 5).Value)
       
        For j = i + 1 To cnt
            target_number = CStr(Cells(j, 5).Value)
           
            If source_number = target_number Then
           
'               Range(Cells(i, 1), Cells(i, 8)).Interior.Color = RGB(255, 255, 0)
'               Range(Cells(j, 1), Cells(j, 8)).Interior.Color = RGB(255, 255, 0)

                ' 중복자료 시트의 행의 수
                cntNew = Worksheets("중복자료").Range("a5").CurrentRegion.Rows.Count + 5
                Debug.Print cntNew
                Range(Cells(i, 1), Cells(i, 8)).Copy Destination:=Worksheets("중복자료").Cells(cntNew, 1)
                Range(Cells(j, 1), Cells(j, 8)).Copy Destination:=Worksheets("중복자료").Cells(cntNew + 1, 1)
               
            End If
           
        Next j
    Next i

End Sub

       
       



 

'04번. IT 힌트얻기 > ▶ Excel' 카테고리의 다른 글

Excel with VB 2번째  (0) 2011.12.21
excel with vb 기초  (0) 2011.12.20
엑셀 비주얼베이직 강좌  (1) 2011.12.20
VB활용한 EXCEL활용 - 라이브러리  (0) 2011.12.20