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
반응형
'Study' 카테고리의 다른 글
안드로이드 설치 (0) | 2013.10.27 |
---|---|
Mavericks 업데이트 후 안드로이드 안될때 (0) | 2013.10.24 |
macro (0) | 2013.09.25 |
macro 9/24 (0) | 2013.09.24 |
macro (0) | 2013.09.23 |