Study

macro

zombie45 2013. 9. 23. 16:16
Sub table99()
    Dim x, y As Integer
    Dim i, j As Integer
    Dim fPath, fName2, fName As String
    Dim LR, NR As Long
    Dim wbGrab As Workbook
    Dim wsDest As Worksheet
    Dim sourceRange As Range
    Dim sheetName As String
    Dim myRange As Range
    Dim myCell As Range
    
    sheetName = "Summary"
    '파일 읽어드리기
    Set wsDest = ThisWorkbook.Sheets(sheetName)
    NR = 1
    
    fPath = "C:\Group\"
    fName = Dir(fPath & "38W.xls*")
    fName2 = Dir(fPath & "2013Y.xls*")
    
    
    Do While Len(fName) > 0
        Set myRange = Range("A6:A1000")
        For Each myCell In myRange
            If myCell Like "*word*" Or _
                myCell Like "*otherword*" Then
                myCell.Font.Bold = True
            End If
        Next myCell
    
        Set wbGrab = Workbooks.Open(fPath & fName)
        'With wbGrab.Worksheets("shizhong") 'find sheet
        '    Set sourceRange = .Range("A2:E2")
        'End With
        
        LR = Range("C" & Rows.Count).End(xlUp).Row 'how many rows of Info?
        
        If LR > 1 Then
            Range("A2:P" & LR).Copy wsDest.Range("C" & NR) 'B2번서부터 시작
            NR = wsDest.Range("B" & Rows.Count).End(xlUp).Row + 1 '마지막 + 1 줄
        End If
        wbGrab.Close False
        fName = Dir
    Loop
        

    x = Range("A1").FormulaR1C1 = "=R[4]C[4]"
    MsgBox (x)
    
'    x = Range("A1")
'    y = Range("A2")
'
'    For i = 2 To 9
'        For j = 1 To 9
'            Cells(Range("A1").Value + j + 1, Range("B1").Value + i - 1) = i & " X " & j & " = " & i * j
'            If i = j Then
'            Cells(Range("A1").Value + j + 1, Range("B1").Value + i - 1) = ""
'            End If
'        Next j
'    Next i

    'Columns("A:H").AutoFit
'    Cells.Item(x, y).Select

End Sub
Sub SORT()
    Dim myRange As Range
    Dim myCell As Range
    Set myRange = Range("A6:A1000")
    For Each myCell In myRange
        If myCell Like "*word*" Or _
            myCell Like "*otherword*" Then
            myCell.Font.Bold = True
        End If
    Next myCell
End Sub

Sub Intersect_Method()

    Dim rngFirst As Range
    Dim rngSecond As Range
    Dim rngIntersect As Range
    Dim i As Integer
   
    Set rngFirst = ActiveSheet.Range("A1:D8")
    Set rngSecond = ActiveSheet.Range("C5:G12")

    rngFirst.Select
    MsgBox "첫번째 영역입니다"

    rngSecond.Select
    MsgBox "두번째 영역입니다. 이제 교차영역을 표시합니다."
    
    Set rngIntersect = Application.Intersect(rngFirst, rngSecond)
    rngIntersect.Select

    'For i = 1 To 1000
        rngIntersect.Interior.ColorIndex = 0
    'Next i

End Sub

Sub somethin()
  Dim i As Long
    With Sheets("Summary")
        For i = 0 To 21
            .Range("B8").Offset(i).Formula = "=Detail!C" & 7 + (i * 12)
        Next i
    End With
End Sub

Sub CopyRows()
    Dim bottomB1, bottomB2 As Integer
    Dim rng1 As Range
    Dim x As Long
    Dim foundVal As Range
    bottomB1 = Sheets("Sheet1").Range("B" & Rows.Count).End(xlUp).Row '시트1 줄
    bottomB2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row '시트2 줄
    For Each rng1 In Sheets("Sheet1").Range("B2:B" & bottomB1) '시트1 B에서 rng1로 셀
        With Sheets("Sheet2").Range("B2:B" & bottomB2) '시트2 B에서 rng1 항목을 찾는다
             Set foundVal = .Find(what:=rng1, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
            If foundVal Is Nothing Then '아무것도 아닐때 제일 밑에 항목으로 새로 추가
                bottomB2 = Sheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
                x = bottomB2 + 1
                rng1.EntireRow.Copy Sheets("Sheet2").Cells(x, "A")
                Sheets("Sheet2").Cells(x, "A").EntireRow.Interior.ColorIndex = 3
            End If
        End With
    Next rng1
End Sub


http://yslife.tistory.com/439
http://www.iexceller.com/MyXls/VBA_Beginner/VBA_Beginner8.asp
http://www.mrexcel.com/forum/excel-questions/
http://msdn.microsoft.com/en-us/library/cc837974.aspx#MergeDataFromMultipleWorkbooks_MergingRangefromSelectedWorkbooks
http://stackoverflow.com/questions/11456881/excel-macro-arrays
반응형