Study

macro

zombie45 2013. 9. 25. 11:50
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
반응형