vba 다른파일 읽어와서 작성하기

Alt+F11

도구-참조

Option Explicit
Sub 사전에첫행지워야함excel로가져오기()
'Ctrl + E
' DB사용시 주의 사항 :
' - 64bit Office(Excel)에서 DAO 3.6 Library를 더 이상 지원하지 않으므로 DAO대신 ABODB를 사용
' - 사전에 VBA편집기의 도구(Tools) => 참조(References)에서 "Microsoft ActiveX Data Object 2.8 Library" 선택
 Dim rs As New ADODB.Recordset
 Dim strSQL As String
 Dim strConn As String
 Dim i As Integer
 Dim 경로 As String
 Dim db As String
 '기존 조회내용 지우기
 Sheets("sheet1").Activate
     Range("a1").CurrentRegion.Clear
 '===== ===== ===== ===== ===== ===== ===== ===== ===== ===== ===== =====
Call 행지우기
'===== ===== ===== ===== ===== ===== ===== ===== ===== ===== ===== =====
 '조회할SQL을 만들어서 String변수에 넣는다.
 strSQL = "SELECT 은행 as [은행코드/은행명],계좌번호 as 입금계좌번호, 지출 as 이체금액,성명 as 출금통장표시내용 FROM [일일결재$] " ' & _
          '" WHERE 부서 = '영업팀'"
 'Excel을 Database로 사용
 경로 = ThisWorkbook.Path
 db = "3.xls"
  strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & 경로 & "\" & db & ";" & "Extended Properties=Excel 12.0;"
 rs.Open strSQL, strConn, adOpenForwardOnly, adLockReadOnly, adCmdText
 If rs.EOF Then
     MsgBox "조회조건에 해당하는 자료가 없습니다."
 Else
     '타이틀을 표시한다.
     For i = 1 To rs.Fields.Count
         Cells(1, i).Value = rs.Fields(i - 1).Name
     Next
     With ActiveSheet
     '조회한 결과집합(rs)을 "출력"Sheet의 A2지점을 꼭지점으로 해서 출력한다.
         .Range("A2").CopyFromRecordset rs
     End With
 End If
 rs.Close
 Set rs = Nothing
'=============================================
Call vba42find일괄바꾸기
'=============================================
Columns("E:H").Delete
' 범위삭제
'Sheets("sheet1").Range(Cells(Rows.Count, "a").End(3)(2).Offset(0, 2), Cells(Rows.Count, "c").End(xlUp)).ClearContents
'Sheets("sheet1").Range(Cells(Rows.Count, "a").End(3)(2), Cells(Rows.Count, "c").End(xlUp)).Delete
Range(Sheets("sheet1").Cells(Rows.Count, 1).End(3)(2), Cells(301, 1)).EntireRow.Delete
ActiveWorkbook.Save
MsgBox "처리완료"
'----- ----- ----- ----- ----- ----- ----- -----
'    Windows("3.xls").Activate
''    ActiveWindow.WindowState = xlNormal
''    Range("B2").Select
'    ActiveWorkbook.Close False
'----- ----- ----- ----- ----- ----- ----- -----
End Sub
Sub 행지우기()
    Dim 경로 As Object
    Dim db As String
    Dim target As String
    Dim xlx As Object, xlw As Object, xls As Object, xlc As Object, xlw2 As Object, xls2 As Object
    Dim wbT As Workbook
'    target = ThisWorkbook.Path & "\3.xls"
    target = "3.xls"
    Set xlx = GetObject(, "Excel.Application")
    If is_wkb_Open(target) Then
        Set wbT = xlx.Workbooks(target)
        '헴펠이체내역201909누적
    Else
'        Application.DisplayAlerts = False
        Set wbT = xlx.Workbooks.Open(target)
'        Application.DisplayAlerts = True
    End If
    Set xls = wbT.Worksheets("일일결재")
'----- ----- ----- ----- ----- ----- ----- -----
    Windows("★다건이체.xls").Activate
    ActiveWindow.WindowState = xlNormal
    Range("A2").Select
'----- ----- ----- ----- ----- ----- ----- -----
End Sub
Sub dateFormula()
'========== ========== ========== ========== ========== ========== ========== ==========
    Dim Date_baseCol As String
    Dim Date_targetCol As String
    Dim Date_rowsCnt As Integer
    Dim Date_rng As Range
    Date_baseCol = "a"
    Date_targetCol = "f"
    Cells(1, Date_targetCol).Value = "일자"
    Date_rowsCnt = Cells(Rows.Count, Date_baseCol).End(3).Row
    Set Date_rng = Range(Cells(2, Date_targetCol), Cells(Date_rowsCnt, Date_targetCol))
    Date_rng.Formula = "=date(left(RC[-5],4),mid(RC[-5],6,2),right(RC[-5],2))"
'========== ========== ========== ========== ========== ========== ========== ==========
    Date_rng.Select
    Selection.Copy
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Range("f1").Select
    ActiveCell.Columns("A:A").EntireColumn.Select
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Select
End Sub
Sub dayFormula()
'========== ========== ========== ========== ========== ========== ========== ==========
    Dim Day_baseCol As String
    Dim Day_targetCol As String
    Dim Day_rowsCnt As Integer
    Dim Day_rng As Range
    Dim Day_targetCell As Range
    Day_baseCol = "a"
    Day_targetCol = "g"
    Cells(1, Day_targetCol).Value = "일"
    Day_rowsCnt = Cells(Rows.Count, Day_baseCol).End(3).Row
    Set Day_rng = Range(Cells(2, Day_targetCol), Cells(Day_rowsCnt, Day_targetCol))
    Day_rng.Formula = "=int(right(RC[-6],2))"
'========== ========== ========== ========== ========== ========== ========== ==========
    Day_rng.Select
    Selection.Copy
'    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
'        :=False, Transpose:=False
    Selection.PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    Range("g1").Select
    ActiveCell.Columns("A:A").EntireColumn.Select
    ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
    ActiveCell.Select
End Sub
Function is_wkb_Open(wkbName As String) As Boolean
    Dim wkb As Workbook                   'workbook을 넣을 변수
    On Error Resume Next                   '에러 발생시에도 코드 계속 진행
    Set wkb = Workbooks(wkbName)    'wkbName을 개체변수에 넣음
    If Not wkb Is Nothing Then              '(만일 변수에 넣었는데)에러 발생하지 않으면
        is_wkb_Open = True                  '그 workbook은 열려있는 것이므로 참값 반환
    Else                                            '아니면
        is_wkb_Open = False                '거짓을 반환. 찾는 workbook이 열려있지 않음.
    End If
End Function
Sub vba42find일괄바꾸기()
'    Sheets("sheet1").Activate
    Dim rng As Range
    Dim cf As Range
    Dim i As Long
    Dim last_row As Long
    Set rng = Range(Sheets("은행코드표").Cells(Rows.Count, 2).End(xlUp), Sheets("은행코드표").Cells(2, 2))
    last_row = Cells(Rows.Count, "a").End(xlUp).Row
    For i = 2 To last_row
        Set cf = rng.Find(Range("a" & i).Value, , , xlWhole) 'xlwhole전체가 일치
'        Sheets("은행코드표").Activate
'        Set cf = Range(Sheets("은행코드표").Cells(Rows.Count, 2).End(xlUp), Sheets("은행코드표").Cells(2, 2))
'        Sheets("sheet1").Activate
        If Not cf Is Nothing Then
'            Range("a" & i) = "'" & Format(cf.Offset(, -1).Value, "000")
            Range("a" & i) = "'" & cf.Offset(, -1).Value
'        Else
'            MsgBox "해당되는 제품코드가 없습니다"
        End If
    Next i
End Sub