엑셀(EXCEL)

엑셀에서 VBA를 사용하는 경우 단순 반복 작업을 자동화하는 경우들에 유용한
방법입니다. 단순하게 반복하는 것과 논리적으로 반복하는 경우의 예를 아래에
들어보겠습니다. 처음에는 매크로 기록 기능으로 사용하다 조금 더 공부하시면
논리적으로 반복을 규칙화 시킬 수 있다고 봅니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3747083
엑셀 메크로 좀 도와주셔요ㅠㅠ

질문의 내용을 보시면 매크로 기록으로 한 번의 반복 작업을 기록하고 이것을
반복적으로 실행하는 법을 질문하셨는데 댓글에 DSFord님께서 반복매크로를
만들어 올려주셨는데 이것을 논리적 반복으로 바꾸어 보겠습니다.

아래의 두 매크로를 한 번 데이터를 500개 정도로 돌려봤는데 속도가 논리적 반복은
1초 정도인데 댓글의 방법으로 하니 150여초 정도 걸렸습니다. 숫자가 몇 천개되면
무시못할 정도의 시간과 쓸데없는? 작업을 하게됩니다.

위의 제목행의 논리를 찾아내는 방법이 어려웠어요. ㅠㅠ
첨부된 그림의 그래프롤 보시면 이해하실 수 있을 것입니다.
지우고 난 열값의 초기화에 따른 제목행을 선정하는 1차함수 유도

y=19*x +1 , 계산을 해 보면 알겠지만 k=0 부터 시작하므로 +1을 함

Cells(1, k + 4) = Cells(Unit * (k + 1) + 1, 1)

위의 코드를 잘 이해하셨으면 대부분의 반복 작업을 처리할 Module하나를
얻었고 이 코드를 응용해서 많은 부분을 자동화 할 수 있을 것으로 보입니다.
그냥 20개 행을 바로 바로 이동하는 코드는 쉬운데 제목행과 데이터행을
단위 갯수로 다르게 분리하는 부분이 상당히 어려운 부분이었습니다.

파일 첨부 : 20160610-리스트 형식을 특정 행으로 분리하여 열에 붙여넣기

오늘도 문제 상황이 발생한 질문이 올라오고 다양한 해결법이 보입니다.
저는 논리력이 부족한 지 함수 특히 배열함수는 어떻게해서 사용해 볼려고 해도
불편해서?(사실 이해가 되질 않아서 ㅠㅠ) 사용하기가 꺼려지더군요.

특히나 여러 함수들을 자유자재로 응용해서 사용하시는 분들을 보면 부럽습니다.
댓글에 여러 해결법들이 있으니 잘 응용해서 사용하시면 실력이 늘 것입니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3674001

서브루틴 자체에 설명을 해 놓았고 변수도 되도록 이해하기 쉽게 정의해 두었으니
천천히 읽어보시면 다 이해되실 것으로 보입니다. 이것 이해하면 왠만한 비교 추출은
다 사용하실 수 있을 것입니다.

Option Explicit

Sub Calc_Parts_By_Plan()

Dim i As Integer, k As Integer
Dim cnt As Integer, ssum As Integer

Dim rngT As Range, rngTgt As Range
Dim rngR As Range, rngRef As Range
Dim rngU As Range, rngUniq As Range

Dim tgt As Worksheet, sht As Worksheet

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

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

End If
Next tgt

Set sht = Sheets(“PPlan”)

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

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

‘ 제목행 삽입을 위해 데이터 위치 조정 및 제목행 삽입과 컬러링
cnt = 1

tgt.Cells(1, 1) = “Model”
tgt.Cells(1, 2) = “Parts”

With tgt.Cells(1, 3).Resize(1, 12)
.Value = sht.Cells(1, 2).Resize(1, 13).Value

.Font.Bold = True
.Interior.Color = &H80C0FF
End With

Set sht = Nothing

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

tgt.Range(“A1”).Offset(cnt, 0).Value = rngR.Offset(0, 0).Value
tgt.Range(“A1”).Offset(cnt, 1).Value = rngR.Offset(0, 1).Value

For i = 0 To 11
tgt.Range(“A1”).Offset(cnt, i + 2).Value = rngR.Offset(0, 2).Value2 * rngT.Offset(0, i + 1).Value2

Next i

cnt = cnt + 1

End If
Next rngR
Next rngT

Set rngTgt = Nothing
Set rngRef = Nothing

‘ 총합계산을 위해 출력할 위치 리셋
cnt = 0

Set sht = Sheets(“ExtData”)

‘ 중복항목을 제거하여 특정 위치에 목록 출력
Call UniqItemRng(Range(“B2”, Range(“B2”).End(xlDown)), Range(“P2”))

Set rngRef = Worksheets(“ExtData”).Range(“B2”, Range(“B2”).End(xlDown)).SpecialCells(xlTextValues)
Set rngUniq = Worksheets(“ExtData”).Range(“P2”, Range(“P2”).End(xlDown)).SpecialCells(xlTextValues)

For k = 1 To 12
For Each rngU In rngUniq
For Each rngR In rngRef

If rngU = rngR Then

ssum = ssum + rngR.Offset(0, k).Value2
tgt.Range(“P2”).Offset(cnt, k).Value = ssum

End If

Next rngR

cnt = cnt + 1
ssum = 0

Next rngU

cnt = 0

Next k

‘ 제목행 삽입
With tgt.Cells(1, 16).Resize(1, 13)
.Value = sht.Cells(1, 2).Resize(1, 15).Value

.Font.Bold = True
.Interior.Color = &H80C0FF
End With

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

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

End Sub

‘ 영역에서 중복 항목 제거해서 지정 위치에 세로로 출력
Sub UniqItemRng(SelRng As Range, TgtRng As Range)

Dim AllCells As Range, Cell As Range
Dim NoDupes As New Collection

Dim i As Integer, j As Integer, k As Integer
Dim Swap1, Swap2, item

Set AllCells = SelRng

On Error Resume Next

For Each Cell In AllCells

If Len(Cell.Value) > 0 Then ‘ 빈셀을 포함시키지 않음
‘ Add method의 2번째 인자는 문자열이어야만 함
NoDupes.Add Cell.Value, CStr(Cell.Value)

End If

Next Cell

On Error GoTo 0

For i = 1 To NoDupes.Count – 1

For j = i + 1 To NoDupes.Count

If NoDupes(i) > NoDupes(j) Then

Swap1 = NoDupes(i)
Swap2 = NoDupes(j)

NoDupes.Add Swap1, before:=j
NoDupes.Add Swap2, before:=i
NoDupes.Remove i + 1
NoDupes.Remove j + 1

End If

Next j

Next i

For Each item In NoDupes

TgtRng.Offset(k, 0).Value = item

k = k + 1

Next item

Set Cell = Nothing
Set AllCells = Nothing

End Sub

첨부화일 : 20160310-부품 소요량 분석

데이터를 다룰 때 정형화되면 좋은데 아래의 질문처럼 정형화된 것도 안된 것도 아닌 질문이
올라오면 참 어떤 형식을 찾는데 힘이 듦니다. 질문에는 정형화된 것처럼 나오는데 만약에
각 열마다 크기가 달라지면 문제가 생깁니다. 물론 배열수식에서 범위를 최대한 넓혀 잡으면
되지만 VBA의 관점에서 보면 난감한 내용입니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3548380
(엑셀 매크로 질문 드립니다, 행별 특정 값 옆의 값 취합)

첨부의 그림과 같이 “X” 마크 옆의 값들을 취합하라는 내용입니다. 루틴은 간단합니다.

Option Explicit

Sub Sum_By_Mark()

Dim RngCel As Range, RngRow As Range

Dim i As Integer, rcnt As Integer

Dim Xsum As Long

Dim sht As Worksheet, tgt As Worksheet

Set sht = Sheets(“Data”)

sht.Select

‘ 취합할 데이터의 행의 수를 체크합니다.
rcnt = sht.Range(“A1”, Range(“A1”).End(xlDown)).Cells.Count

‘ 데이터 취합할 시트를 초기화 합니다.
For Each tgt In Worksheets

If tgt.Name = “X_Cnt_Row” Then

Application.DisplayAlerts = False

tgt.Delete

Application.DisplayAlerts = True

End If
Next

‘ 새 시트를 만듭니다.
Worksheets.Add.Name = “X_Cnt_Row”

‘ 행만큼 루프를 돌립니다.
For i = 1 To rcnt

‘ 영역을 열마다 재설정 합니다. 행의 제일 뒤에서 값이 나타날 때까지 취합니다.
Set RngRow = sht.Range(“B” & i, sht.Range(“B” & i).Offset(0, 256).End(xlToLeft))

‘ 취합할 데이터의 제목행을 새 시트로 옮깁니다
Sheets(“X_Cnt_Row”).Range(“A” & i).Value = RngRow.Offset(0, -1).Value

‘ 영역을 순환합니다.
For Each RngCel In RngRow

‘ 영역의 컬럼을 체크하여 필요없는 부분을 건너뜁니다.
If RngCel.Column / 2 <> 0 Then

‘ 영역과 비교하여 참값을 취하여 더해 줍니다
If UCase(RngCel.Offset(0, 1).Value) = “X” Then
Xsum = Xsum + RngCel.Value

End If

End If

Next RngCel

‘ 더해진 값을 취합 시트에 넣어줍니다.
Sheets(“X_Cnt_Row”).Range(“A” & i).Offset(0, 1).Value = Xsum

‘ 행의 더한 값을 초기화 시킵니다.
Xsum = 0
Next i

End Sub

주석 참고하시면 쉽게 이해하실 수 있을 것입니다. 만약에 “O” 마크를 찾고 싶으면 코드 중에서
if RngCel.Column / 2 <> 0 then 을 if RngCel.Column / 2 = 0 then로 바꾸시고 그 아래 코드를
If UCase(RngCel.Offset(0, 1).Value) = “X” Then의 “X”를 “O”로 바꾸시면 됩니다.

아래 코멘트처럼 간단하게 처리할 수도 있지만 VBA를 요청하셔서 올립니다.

첨부 화일 : 20151008-각 행별의 셀 패턴별 숫자 합치기