20160309173945

엑셀[EXCEL] – 같은 셀 값 참조하여 두 시트 합침

 

아질게 게시판에 엑셀 관련 조금 복잡한 질문의 내용들이 나오지 않아
심심하던 차에? 조금 복잡한 내용이 나왔네요.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3673755
하루종일 검색해보았지만 알 수 없었던 엑셀문제ㅠ 혹시 아시는 분 계실까요?

질문의 내용이 더 어려워 해석하느라 시간이 좀 걸렸습니다. 한 칼럼을 기준으로
같은 내용이 있으면 두 시트를 일정 방법으로 합쳐달라는 요지더군요.

간단히 VLOOKUP함수로 처리할 수도 있지만 저는 함수를 잘 활용하지 못하고
정형화된 내용은 VBA로 해결하는 사람이라 VBA로 짧은 코드 한번 짜 보았습니다.

Option Explicit

Sub Mergy_By_Same_Value()

Dim cnt As Integer, i As Integer

Dim rngCell As Range, rngTgt As Range
Dim rngR As Range, rngRef As Range

Dim tgt As Worksheet

‘ 경고 메시지 금지 및 속도를 위해 업데이트 중지
Application.DisplayAlerts = False
Application.ScreenUpdating = False

‘ 추출해서 붙여넣기할 데이터 시트가 기존에 있으면 삭제
For Each tgt In Worksheets
If tgt.Name = “ExtData” Then
tgt.Delete

End If
Next tgt

‘ 새 시트를 워크시트 제일 마지막에 ExtData라는 이름으로 추가
Set tgt = Worksheets.Add(after:=Worksheets(Worksheets.Count))
tgt.Name = “ExtData”

‘ 추출할 데이터 영역과 추출할 참조 영역 설정
Set rngTgt = Worksheets(“Alpha”).Range(“G:G”).SpecialCells(xlTextValues)
Set rngRef = Worksheets(“Beta”).Range(“G:G”).SpecialCells(xlTextValues)

‘ 두 영역을 순환하면서 같은 데이터가 있으면 추출 시트에 복사
For Each rngCell In rngTgt

For Each rngR In rngRef

If rngCell = rngR Then
‘셀 병합하여 붙여넣을 위치 결정
For i = 0 To 6
tgt.Range(“A1”).Offset(cnt, i * 2).Value = rngCell.Offset(0, i – 6).Value
tgt.Range(“A1”).Offset(cnt, i * 2 + 1).Value = rngR.Offset(0, i – 6).Value

Next i

cnt = cnt + 1

Exit For

End If

Next rngR

Next rngCell

‘ 보기 좋게 자동 칼럼 맞춤
‘ tgt.Columns.AutoFit

‘ 경고 메시지 및 업데이트 갱신
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

참조 : 20160309-같은 셀값 참조하여 두 시트 합침

By • 무른모 • 0 • Tags: , , ,

20160218175029

[엑셀] – 바코드, 터치 스크린, 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 • 무른모 • 0 • Tags: , , , , ,

20160217093310

[엑셀] – 각 워크북의 특정 시트의 특정열 병합

 

오랜만에 자료 올리네요. 기존에 내용이 있어서 쉽게 만들 수 있었네요.

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-각 워크북의 특정 시트의 특정열 병합

 

By • 무른모 • 0 • Tags: , , ,

«< 23 24 25 26 27 >»