Sub table99() Dim inputRow, outputRow As Integer Dim i, j As Integer Dim row1, row2, col1, col2 As Long Dim fPath, fName2, fName As String Dim wbFrom As Workbook Dim wsSetup, wsFrom, wsTo As Worksheet Dim sheetName As String sheetName = "SDP" If SheetExists(sheetName, ThisWorkbook.Name) Then 'turn off alert to user before auto deleting a sheet so the function is not interrupted ' Application.DisplayAlerts = False ' ThisWorkbook.Worksheets(sheetName).Delete ' Application.DisplayAlerts = True Else 'Activating ThisWorkbook in case it is not Application.Sheets.Add.Name = sheetName End If Set wsSetup = Excel.Worksheets("Setup") 'Set wsFrom = Excel.Worksheets(wsSetup.Cells(6, 2).Value) Set wsFrom = Excel.Worksheets(sheetName) Set wsTo = ThisWorkbook.Sheets(sheetName) outputRow = wsSetup.Cells(7, 2).Value inputRow = wsSetup.Cells(8, 2).Value row1 = wsFrom.Range("C" & Rows.Count).End(xlUp).Row row2 = wsTo.Range("C" & Rows.Count).End(xlUp).Row col1 = wsFrom.UsedRange.Columns.Count col2 = wsTo.UsedRange.Columns.Count '파일 읽어드리기 fPath = "C:\Group\" fName = Dir(fPath & wsSetup.Cells(5, 2).Value & ".xls*") Do While Len(fName) > 0 Set wbFrom = Workbooks.Open(fPath & fName) row2 = Range("C" & Rows.Count).End(xlUp).Row 'how many rows of Info? If row2 > 0 Then Range("A1:P" & row2).Copy wsTo.Range("C" & row1) 'B2번서부터 시작 row1 = wsTo.Range("B" & Rows.Count).End(xlUp).Row + 1 '마지막 + 1 줄 End If wbFrom.Close False fName = Dir Loop ' ' If LCase(wsFrom.Cells(2, outputRow).Value) <> LCase(wsTo.Cells(1, inputRow).Value) Then ' MsgBox (wsFrom.Cells(2, outputRow).Value & "!=" & wsTo.Cells(1, inputRow).Value) ' Else ' For i = 2 To row2 ' For j = 2 To row1 ' If wsTo.Cells(j, 3).Value = wsFrom.Cells(i, 3).Value Then ' wsTo.Cells(j, 2).Value = i & "Row" ' wsFrom.Cells(i, outputRow).Value = wsTo.Cells(j, inputRow).Value ' End If ' Next j ' Next i ' ' End If ' x = Range("A1").FormulaR1C1 = "R[4]C[4]" ' x = Cells(3, 3) ' MsgBox (x) ' Set myRange = Range("C3:C") ' For Each myCell In myRange ' If myCell Like "*word*" Or _ ' myCell Like "*otherword*" Then ' myCell.Font.Bold = True ' End If ' Next myCell ' ' 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 copy_table2() Dim inputRow, outputRow As Integer Dim wsSetup, fromSheet, toSheet As Worksheet Dim i, j As Integer Dim row1, row2, col1, col2 As Long Dim fromCol, toCol As Long Dim strFind As String Set wsSetup = Excel.Worksheets("Setup") Set toSheet = Excel.Worksheets(wsSetup.Cells(13, 2).Value) strFind = wsSetup.Cells(14, 2).Value Set fromSheet = ThisWorkbook.Sheets(wsSetup.Cells(12, 2).Value) row2 = toSheet.Range("C" & Rows.Count).End(xlUp).Row row1 = fromSheet.Range("C" & Rows.Count).End(xlUp).Row col1 = fromSheet.UsedRange.Columns.Count col2 = toSheet.UsedRange.Columns.Count Do While 1 If fromSheet.Cells(1, col1).Value = "" Then col1 = col1 - 1 Else Exit Do End If Loop Do While 1 If toSheet.Cells(2, col2).Value = "" Then col2 = col2 - 1 Else Exit Do End If Loop fromCol = 0 toCol = 0 For i = 1 To col1 If LCase(fromSheet.Cells(1, i).Value) = LCase(strFind) Then fromCol = i Exit For End If Next i For i = 1 To col2 If LCase(toSheet.Cells(2, i).Value) = LCase(strFind) Then toCol = i Exit For End If Next i If fromCol = 0 Or toCol = 0 Then MsgBox ("No " & strFind) Else inputRow = fromCol outputRow = toCol If LCase(toSheet.Cells(2, outputRow).Value) <> LCase(fromSheet.Cells(1, inputRow).Value) Then MsgBox (toSheet.Cells(2, outputRow).Value & "!=" & fromSheet.Cells(1, inputRow).Value) Else For j = 2 To row1 If fromSheet.Cells(j, 2).Value = "" Then fromSheet.Cells(j, 2).Interior.Color = RGB(255, 0, 6) End If For i = 2 To row2 If fromSheet.Cells(j, 3).Value = toSheet.Cells(i, 3).Value Then If fromSheet.Cells(j, 1).Value = "" Then fromSheet.Cells(j, 1).Value = wsSetup.Cells(13, 2).Value Else If LCase(fromSheet.Cells(j, 1).Value) <> LCase(wsSetup.Cells(13, 2).Value) Then fromSheet.Cells(j, 1).Value = fromSheet.Cells(j, 1).Value & " " & wsSetup.Cells(13, 2).Value Else fromSheet.Cells(j, 1).Value = wsSetup.Cells(13, 2).Value End If End If fromSheet.Cells(j, 2).Value = i & "Row" fromSheet.Cells(j, 2).Interior.ColorIndex = xlNone toSheet.Cells(i, outputRow).Value = fromSheet.Cells(j, inputRow).Value Exit For End If Next i Next j End If MsgBox ("OK") End If End Sub Sub copy_table() Dim inputRow, outputRow As Integer Dim fromSheet, toSheet As Worksheet Dim wsSetup As Worksheet Dim row2, row1, col1, col2 As Integer Dim i, j As Integer Set wsSetup = Excel.Worksheets("Setup") Set fromSheet = Excel.Worksheets(wsSetup.Cells(5, 2).Value) Set toSheet = Excel.Worksheets(wsSetup.Cells(6, 2).Value) outputRow = Range(wsSetup.Cells(6, 3).Value & 1).Column inputRow = Range(wsSetup.Cells(5, 3).Value & 1).Column row2 = toSheet.Range("C" & Rows.Count).End(xlUp).Row row1 = fromSheet.Range("C" & Rows.Count).End(xlUp).Row If LCase(toSheet.Cells(2, outputRow).Value) <> LCase(fromSheet.Cells(1, inputRow).Value) Then MsgBox (toSheet.Cells(2, outputRow).Value & "!=" & fromSheet.Cells(1, inputRow).Value) Else For j = 2 To row1 If fromSheet.Cells(j, 2).Value = "" Then fromSheet.Cells(j, 2).Interior.Color = RGB(255, 0, 6) End If For i = 2 To row2 If fromSheet.Cells(j, 3).Value = toSheet.Cells(i, 3).Value Then If fromSheet.Cells(j, 1).Value = "" Then fromSheet.Cells(j, 1).Value = wsSetup.Cells(13, 2).Value Else If LCase(fromSheet.Cells(j, 1).Value) <> LCase(wsSetup.Cells(13, 2).Value) Then fromSheet.Cells(j, 1).Value = fromSheet.Cells(j, 1).Value & " " & wsSetup.Cells(13, 2).Value Else fromSheet.Cells(j, 1).Value = wsSetup.Cells(13, 2).Value End If End If fromSheet.Cells(j, 2).Value = i & "Row" fromSheet.Cells(j, 2).Interior.ColorIndex = xlNone toSheet.Cells(i, outputRow).Value = fromSheet.Cells(j, inputRow).Value Exit For End If Next i Next j MsgBox ("OK") End If End Sub Sub DATAUPDATE() ActiveWorkbook.RefreshAll ' ' Dim ws As Worksheet, q As QueryTable ' ' For Each ws In ActiveWorkbook.Worksheets ' For Each q In ws.QueryTables ' q.Refresh (False) ' Next ' Next MsgBox ("OK") End Sub
반응형
'Study' 카테고리의 다른 글
Mavericks 업데이트 후 안드로이드 안될때 (0) | 2013.10.24 |
---|---|
macro 9/26 (0) | 2013.09.27 |
macro 9/24 (0) | 2013.09.24 |
macro (0) | 2013.09.23 |
엑셀 메크로 (0) | 2013.09.23 |