Study

macro 9/26

zombie45 2013. 9. 27. 08:48
Sub jaego()
    Dim i, j, k, l As Long
    Dim wsFrom1, wsFrom2, wsFrom3, wsFrom4, wsTo As Worksheet
    Dim row1, row2, row3, row4, row5, col1, col2 As Long
    Dim sum As Long
    
    'Excel.ActiveWorkbook.RefreshAll
    
    
    Dim fPath, fName As String
    Dim wbFromFile As Workbook
    Dim wsToFile, wsFromFile As Worksheet
    Dim strName As String
    
    Set wsToFile = Excel.Worksheets(1)
    
    fPath = ThisWorkbook.Path
    fName = Dir(fPath & "\" & "*.xlsx")


    Do While Len(fName) > 0
        'MsgBox (fName)
        
'        If fName = "yingye.xlsm" Then
'            strName = "yingye"
'
'            Set wbFromFile = Workbooks.Add(fPath & "\" & fName)
'            Set wsFromFile = wbFromFile.Worksheets("DVR")
'    'dvr cctv sdp
'            Application.DisplayAlerts = False
'            Worksheets(strName).Delete
'            Application.DisplayAlerts = True
'            wsFromFile.Select
'            wsFromFile.Copy After:=wsToFile
'
'            Excel.Worksheets(2).Name = strName
'            Excel.Worksheets(2).Range("A1").EntireColumn.Insert
'
'            wbFromFile.Close False
'            fName = Dir
'
'        Else
            If fName = "penturizaiku.xlsx" Then
                strName = "pentu"
            End If
            If fName = "SJErishengchanzaiku.xlsx" Then
                strName = "shengchan"
            End If
            If fName = "zhilirizaiku.xlsx" Then
                strName = "zhili"
            End If
                        
            Set wbFromFile = Workbooks.Add(fPath & "\" & fName)
            Set wsFromFile = wbFromFile.Worksheets("Sheet1")
    
            Application.DisplayAlerts = False
            Worksheets(strName).Delete
            Application.DisplayAlerts = True
            wsFromFile.Select
            wsFromFile.Copy After:=wsToFile
            
            Excel.Worksheets(2).Name = strName
            Excel.Worksheets(2).Range("A1").EntireColumn.Insert
            
            wbFromFile.Close False
            fName = Dir

'        End If
    Loop
    
    Set wsTo = Excel.Worksheets("Sheet1")
    Set wsFrom1 = Excel.Worksheets("pentu")
    Set wsFrom2 = Excel.Worksheets("zhili")
    Set wsFrom3 = Excel.Worksheets("shengchan")
'    Set wsFrom4 = Excel.Worksheets("yingye")
    
    row1 = wsTo.Range("C" & Rows.Count).End(xlUp).Row ' to 567
    row2 = wsFrom1.Range("D" & Rows.Count).End(xlUp).Row 'M(13) data CL
    row3 = wsFrom2.Range("D" & Rows.Count).End(xlUp).Row 'M data CL
    row4 = wsFrom3.Range("E" & Rows.Count).End(xlUp).Row 'N data EO
'    row5 = wsFrom4.Range("D" & Rows.Count).End(xlUp).Row 'N data EO
    
    For i = 3 To row1
        For j = 2 To row2
            If Replace(wsFrom1.Cells(j, 4).Value, " ", "") = Replace(wsTo.Cells(i, 3).Value, " ", "") Then
                wsTo.Cells(i, 5).Value = wsFrom1.Cells(j, 13).Value
                wsFrom1.Cells(j, 1).Value = wsFrom1.Cells(j, 1) & " " & i
            End If
        Next j
        
        For j = 2 To row3
            If Replace(wsFrom2.Cells(j, 4).Value, " ", "") = Replace(wsTo.Cells(i, 3).Value, " ", "") Then
                wsTo.Cells(i, 6).Value = wsFrom2.Cells(j, 13).Value
                wsFrom2.Cells(j, 1).Value = wsFrom2.Cells(j, 1) & " " & i
            End If
        Next j
        
        For j = 2 To row4
            If Replace(wsFrom3.Cells(j, 5).Value, " ", "") = Replace(wsTo.Cells(i, 3).Value, " ", "") Then
                wsTo.Cells(i, 7).Value = wsFrom3.Cells(j, 15).Value
                wsFrom3.Cells(j, 1).Value = wsFrom3.Cells(j, 1) & " " & i
            End If
        Next j
        
'        For j = 2 To row5
'            If Replace(wsFrom4.Cells(j, 5).Value, " ", "") = Replace(wsTo.Cells(i, 3).Value, " ", "") Then
'                wsTo.Cells(i, 7).Value = wsFrom4.Cells(j, 15).Value
'                wsFrom4.Cells(j, 1).Value = wsFrom4.Cells(j, 1) & " " & i
'            End If
'        Next j
    Next i
    MsgBox ("OK")
End Sub
Sub jia_yiyangde()
    Dim i, j, k As Integer
    Dim sum As Long
    Dim row1, row2, row3 As Long
    Dim wsFrom, wsTo As Worksheet
    
    Set wsFrom = Excel.Worksheets("Setup")
    Set wsTo = Excel.Worksheets(wsFrom.Cells(1, 1).Value)
    row1 = wsFrom.Range("B" & Rows.Count).End(xlUp).Row
    row3 = wsTo.Range("C" & Rows.Count).End(xlUp).Row
    
    sum = 0
    j = 2
    For i = 2 To row1
        sum = sum + wsFrom.Cells(i, 5).Value
        If wsFrom.Cells(i, 2).Value <> wsFrom.Cells(i + 1, 2).Value Then
            wsFrom.Cells(j, 10).Value = wsFrom.Cells(i, 2).Value
            wsFrom.Cells(j, 11).Value = wsFrom.Cells(i, 6).Value
            wsFrom.Cells(j, 12).Value = sum
            j = j + 1
            wsFrom.Cells(i, 9).Value = sum
            sum = 0
        End If
    Next i
    row2 = j
    
'    For i = 2 To row2
'        If wsFrom.Cells(i, 7).Value = "" Then
'            wsFrom.Cells(i, 7).Interior.Color = RGB(255, 0, 0)
'        End If
'    Next i
'
    For i = 2 To row2
        wsFrom.Cells(i, 13).Interior.Color = RGB(255, 0, 0)
        For j = 2 To row3
            If Replace(wsFrom.Cells(i, 10).Value, " ", "") = Replace(wsTo.Cells(j, 3).Value, " ", "") Then
                wsTo.Cells(j, 5) = wsFrom.Cells(i, 11).Value
                wsTo.Cells(j, 6) = wsFrom.Cells(i, 12).Value
                wsFrom.Cells(i, 13).Interior.ColorIndex = xlNone
                Exit For
            End If
        Next j
    Next i

    MsgBox ("OK")
End Sub

Sub setcolor()
    Dim i, j, k As Integer
    Dim row1 As Long
    Dim wsThis As Worksheet
    
    Set wsThis = Excel.Worksheets("Sheet1")
    row1 = wsThis.Range("H" & Rows.Count).End(xlUp).Row
    
    For i = 2 To row1
        wsThis.Cells(i, 7).Interior.Color = wsThis.Cells(i, 5).Interior.Color
    Next i
End Sub

Sub jaego()
    Dim i, j, k, l As Long
    Dim wsFrom1, wsFrom2, wsFrom3, wsTo As Worksheet
    Dim row1, row2, row3, row4, col1, col2 As Long
    Dim sum As Long
    
    'Excel.ActiveWorkbook.RefreshAll
    
    
    Set wsTo = Excel.Worksheets("Sheet1")
    Set wsFrom1 = Excel.Worksheets("fendu")
    Set wsFrom2 = Excel.Worksheets("zhili")
    Set wsFrom3 = Excel.Worksheets("shengshan")
    
    row1 = wsTo.Range("C" & Rows.Count).End(xlUp).Row ' to 567
    row2 = wsFrom1.Range("D" & Rows.Count).End(xlUp).Row 'M(13) data
    row3 = wsFrom2.Range("D" & Rows.Count).End(xlUp).Row 'M data
    row4 = wsFrom2.Range("D" & Rows.Count).End(xlUp).Row 'N data
    
    For i = 3 To row1
        For j = 2 To row2
            If Replace(wsFrom1.Cells(j, 4).Value, " ", "") = Replace(wsTo.Cells(i, 3).Value, " ", "") Then
                wsTo.Cells(i, 5).Value = wsFrom1.Cells(j, 13).Value
                wsFrom1.Cells(j, 1).Value = i
            End If
        Next j
        
        For j = 2 To row3
            If Replace(wsFrom2.Cells(j, 4).Value, " ", "") = Replace(wsTo.Cells(i, 3).Value, " ", "") Then
                wsTo.Cells(i, 6).Value = wsFrom2.Cells(j, 13).Value
                wsFrom2.Cells(j, 1).Value = i
            End If
        Next j
        
        For j = 2 To row4
            If Replace(wsFrom3.Cells(j, 4).Value, " ", "") = Replace(wsTo.Cells(i, 3).Value, " ", "") Then
                wsTo.Cells(i, 7).Value = wsFrom3.Cells(j, 14).Value
                wsFrom2.Cells(j, 1).Value = i
            End If
        Next j
    Next i
    MsgBox ("OK")
End Sub
Sub checkver()

    Dim ea As Object
    Dim fnCheckExcel As String

    'Set ea = CreateObject("Excel.Application")

    'fnCheckExcel = ea.Version

    'Set ea = Nothing

    'MsgBox (fnCheckExcel)
    

End Sub
반응형