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
반응형