2월 17 2016
[엑셀] – 각 워크북의 특정 시트의 특정열 병합
오랜만에 자료 올리네요. 기존에 내용이 있어서 쉽게 만들 수 있었네요.
Option Explicit
Sub MergeWBs()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = “C:\Data”
Set wbDst = ThisWorkbook
strFilename = Dir(MyPath & “\*.xls”, vbNormal)
If Len(strFilename) = 0 Then Exit Sub
Do Until strFilename = “”
Set wbSrc = Workbooks.Open(Filename:=MyPath & “\” & strFilename)
Set wsSrc = wbSrc.Worksheets(1)
wsSrc.Copy after:=wbDst.Worksheets(wbDst.Worksheets.Count)
wbSrc.Close False
strFilename = Dir()
Loop
wbDst.Worksheets(1).Delete
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Sub MergeWSs()
Dim wrk As Workbook
Dim sht As Worksheet
Dim trg As Worksheet
Dim rng As Range
Dim colCount As Integer
Set wrk = ActiveWorkbook
Application.DisplayAlerts = False
For Each sht In wrk.Worksheets
If sht.Name = “Master” Or sht.Name = “ExtData” Then
sht.Delete
End If
Next sht
Application.DisplayAlerts = True
Application.ScreenUpdating = False
Set trg = wrk.Worksheets.Add(after:=wrk.Worksheets(wrk.Worksheets.Count))
trg.Name = “ExtData”
Set sht = wrk.Worksheets(1)
With trg.Cells(1, 1).Resize(1, 3)
.Value = sht.Cells(1, 1).Resize(1, 3).Value
.Font.Bold = True
.Interior.Color = vbGreen
End With
For Each sht In wrk.Worksheets
If sht.Index = wrk.Worksheets.Count Then
Exit For
End If
Set rng = sht.Range(sht.Cells(31, 1), sht.Cells(31, 1).Resize(, 4))
trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, 3).Value = rng.Value
Next sht
trg.Activate
trg.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
차근 차근 읽어보시면 이해가 되실 것입니다.
첨부 : 20160217-각 워크북의 특정 시트의 특정열 병합
2월 18 2016
[엑셀] – 바코드, 터치 스크린, DAO를 이용한 창고 관리
간이 재고관리이지만 코드가 길어서 그냥 아래 팁들을 올립니다.
바코드 리더를 이용 입력하고, 터치스크린으로 숫자를 누를 때마다
그 숫자를 텍스트 박스로 숫자 입력을 가능하게 하는 루틴입니다.
Option Explicit
Function Touch_Btn(obj1 As Object, obj2 As Object) As Integer
Select Case obj1.Caption
Case “1”
obj2.Value = Val(obj2.Text + “1”)
Case “2”
obj2.Value = Val(obj2.Text + “2”)
Case “3”
obj2.Value = Val(obj2.Text + “3”)
Case “4”
obj2.Value = Val(obj2.Text + “4”)
Case “5”
obj2.Value = Val(obj2.Text + “5”)
Case “6”
obj2.Value = Val(obj2.Text + “6”)
Case “7”
obj2.Value = Val(obj2.Text + “7”)
Case “8”
obj2.Value = Val(obj2.Text + “8”)
Case “9”
obj2.Value = Val(obj2.Text + “9”)
Case “0”
obj2.Value = Val(obj2.Text + “0”)
End Select
End Function
그리고 두번째 팁으로 ◀버튼을 누를 때마다 마지막 숫자를 지워서 다시
입력할 수 있도록 하는 팁입니다.
Private Sub Del_Last_Input()
Dim TempStr As String
If Len(TextBox4.Text) > 0 Then
TempStr = Left(TextBox4.Text, Len(TextBox4.Text) – 1)
TextBox4.Text = TempStr
End If
End Sub
나머지는 코드가 거의 1천여줄이라 엑셀파일을 제 블로그에 첨부해 두겠습니다.
찬찬히 훓어보시면 이해가 가시리라 봅니다. 거의 예제 수준이므로 공부하는데
도움이 되었으면 합니다.
첨부 : Manage_Stock
By vinipapa • 무른모 • 0 • Tags: DAO, 바코드, 엑셀, 창고관리, 터치스크린, 팁