zombie45
zombie's dev story
zombie45

공지사항

  • 분류 전체보기
    • iPhone
    • Study

인기 글

최근 댓글

최근 글

티스토리

반응형

블로그 메뉴

  • 홈
  • 태그
  • 미디어로그
  • 위치로그
  • 방명록
  • 글쓰기
전체 방문자
오늘
어제

태그

  • UIViewController
  • 안드로이드
  • Nodejs node express expressjs
  • 큰파일
  • cache
  • Animtaion
  • CI/CD
  • android_key_hash
  • 큰폴더
  • code spell checker
  • 자동배포
  • textformfield
  • 티스토리챌린지
  • jks
  • intl
  • actions
  • caching
  • l10nization
  • flutter_localizations
  • cocoapods-binary-cache
  • TextInputAction
  • appDelegate
  • flutter l10n helper
  • 카카오 로그인
  • Box2d cocos2dx cocos2d-x
  • cspell
  • FocusScope
  • 오블완
  • Flutter
  • nextFocus
hELLO · Designed By 정상우.
zombie45

zombie's dev story

Study

macro 9/26

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

'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
    'Study' 카테고리의 다른 글
    • 안드로이드 설치
    • Mavericks 업데이트 후 안드로이드 안될때
    • macro
    • macro 9/24
    zombie45
    zombie45
    잡다한 개발

    티스토리툴바