랜덤 동작 문제. 작동될 때도 있고 안될때도 있음.

VBA
작성자
병욱
작성일
2021-11-01 11:19
조회
60
엑셀버전 : 엑셀2016

운영체제 : 윈도우10

Option Explicit
Global E_Row As Double
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)

Sub Sum()

Dim F_dlg As FileDialog
Dim MyWB, OPWB As Workbook
Dim F_Path, F_Name As String
Dim S_Row, D_Row As Integer
Dim O_Name As String

Set MyWB = ActiveWorkbook

Set F_dlg = Application.FileDialog(msoFileDialogFolderPicker)

Application.DisplayAlerts = False
Application.ScreenUpdating = False

F_dlg.Show

F_Path = F_dlg.SelectedItems(1)
F_Name = Dir(F_Path & "\*.xls*")

Do While F_Name <> ""
If InStr(1, F_Name, "아파트") <> 0 Then
Set OPWB = Workbooks.Open(F_Path & "\" & F_Name)
Sleep 5000

OPWB.Sheets(1).Select
Sheets(1).Move Before:=MyWB.Sheets("summary")
Rows("1:16").Delete
Range("A99999").Select
Selection.End(xlUp).Select
E_Row = Selection.Row

SplitItems ("매매1")

Range("A2:A" & E_Row).Value2 = "아파트"

Range("A2:X" & E_Row).Copy

Sheets("Summary").Select

Range("A99999").Select
Selection.End(xlUp).Select
S_Row = Selection.Row

Range("A" & S_Row + 1).Select
ActiveSheet.Paste
Sheets(1).Delete

End If
F_Name = Dir()

Loop

Sheets("Summary").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True

ㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡ

End Sub

Function SplitItems(Item As String)

' 매매1,전월세1 => 아파트 오피스텔 전립다세대

Select Case Item
Case Is = "매매1"
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("L:L").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("R:R").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

Range("K2:k" & E_Row).Value2 = "매매"

Case Is = "전월세1"
Columns("F:F").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("L:L").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

Case Is = "매매2"
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("J:J").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("R:R").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("A:A").Select
Selection.Insert Shift:=xlToRight

Range("K2:k" & E_Row).Value2 = "매매"

Case Is = "전월세2"
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Selection.Insert Shift:=xlToRight
Columns("Q:Q").Select
Selection.Insert Shift:=xlToRight
Columns("S:S").Select
Selection.Insert Shift:=xlToRight
End Select

End Function

ㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡㅡ

 

총 4분류로 여러개 파일을 한 파일로 통일시키려고 만든 매크로입니다. splititems는 분류에 따라 단순히 열을 추가하는 함수입니다.

문제는 f8을 통해 실행시켰을 때는 매크로가 정상동작하는데 정작 매크로를 실행하면 분류하려는 파일창만 열리고 vba는 동작이 정지합니다. 그리고 3~4번에 1번꼴로 매크로도 정상동작합니다.  같은 컨디션에서 20~30% 확률로 정상동작.. 딜레이도 여러군데 걸어봤는데 해결이 안되네요.

회원등급 : 4레벨
포인트 : 169 EP
총질문 : 7 개 (마감율 : 43%)
채택답변 : 1 개
전체 0

전체 4,679
번호 카테고리 제목 작성자 작성일 추천 조회
공지사항 공지사항
⭐ [더 나은 커뮤니티 문화를 위한 Q&A 글 작성 규칙] ⭐ (10)
오빠두엑셀 | 2021.10.28 | 추천 16 | 조회 753
트로피 오빠두엑셀 2021.10.28 16 753
24253 함수/공식
New 파일과 관련된 숫자를 다른 파일에 있는 숫자로 변경할 수 있는 방법 첨부파일 (1)
안녕 | 2021.12.02 | 추천 0 | 조회 11
안녕 2021.12.02 0 11
24252 함수/공식
New 표 범위 내에서 맨 좌측값 가져오기 질문드립니다. (2)
김성환 | 2021.12.02 | 추천 0 | 조회 12
김성환 2021.12.02 0 12
24251 기능/도구
New 엑셀 주식 가격 예측 양식 사용 질문입니다. 첨부파일 (1)
thause | 2021.12.02 | 추천 0 | 조회 18
thause 2021.12.02 0 18
24249 VBA
New 모든 하위 폴더 내의 최신 파일 하나만을 특정 폴더로 복사하려 합니다
너의나라 | 2021.12.02 | 추천 0 | 조회 17
너의나라 2021.12.02 0 17
24248 차트/그래프
New 그래프에서 가로 축 Data 설정하는 법 첨부파일
Etter | 2021.12.02 | 추천 0 | 조회 20
Etter 2021.12.02 0 20
24245 VBA
New 아웃룩 이메일 내용에 VBA 변수 넣기 (1)
argus | 2021.12.02 | 추천 0 | 조회 21
argus 2021.12.02 0 21
24239 VBA
New [초보] 웹 크롤링 관련 질문입니다. 첨부파일 (2) 답변완료
스캐쳐 | 2021.12.02 | 추천 0 | 조회 24
스캐쳐 2021.12.02 0 24
24238 VBA
New 어떤 한 배열에서 다른 배열에 있는 값만 제외하고 새로운 배열3을 만들 수 있을까요? (2)
Paul | 2021.12.02 | 추천 0 | 조회 24
Paul 2021.12.02 0 24
24233 함수/공식
New 0이상의 값(유효값)이 있는 칼럼과 그 값을 불러오고 싶습니다. 첨부파일 (2) 답변완료
크놉스 | 2021.12.02 | 추천 0 | 조회 25
크놉스 2021.12.02 0 25
24232 차트/그래프
New 엑셀 차트에서 특정 값이 너무 높을때 차트화 하는 법 (2) 답변완료
담담 | 2021.12.02 | 추천 0 | 조회 31
담담 2021.12.02 0 31
24230 VBA
New vba 코딩을 부탁드립니다. 첨부파일 (2)
Trimman | 2021.12.02 | 추천 -2 | 조회 33
Trimman 2021.12.02 -2 33
24228 함수/공식
New 등급 기준표를 참조해서 연산을 하려고 할때 (1) 답변완료
지천 | 2021.12.02 | 추천 0 | 조회 22
지천 2021.12.02 0 22
24221 파워쿼리/피벗
New 엑셀 종속 테이블 문의 첨부파일 (2)
유령회원 | 2021.12.02 | 추천 0 | 조회 22
유령회원 2021.12.02 0 22
24216 VBA
New 로그인엑셀 사용시 수식입력줄 사라짐, 모든 엑셀창 자동종료 첨부파일 (1)
엑셀이 | 2021.12.02 | 추천 0 | 조회 19
엑셀이 2021.12.02 0 19
24215 VBA
New set_routine 반복 매크로 (1)
하늘의 꿈 | 2021.12.01 | 추천 0 | 조회 24
하늘의 꿈 2021.12.01 0 24
VBA
New 재질문 입니다.
하늘의 꿈 | 2021.12.02 | 추천 0 | 조회 12
하늘의 꿈 2021.12.02 0 12
24213 파워쿼리/피벗
New [파워쿼리] 계약자코드 중 특수계약 날짜가 일반계약 최소 최대 사이에 포함여부 열추가 첨부파일 (1)
seorin | 2021.12.01 | 추천 0 | 조회 20
seorin 2021.12.01 0 20
24211 VBA
New 시트를 메일머지하여 Hancom PDF 파일로 출력하는 매크로 VBA 코드 도움을 받고 싶어요. 첨부파일 (4) 답변완료
김학동 | 2021.12.01 | 추천 0 | 조회 34
김학동 2021.12.01 0 34
24210 함수/공식
New 혹시 이런 것도 구할 수 있을까요? (3)
마른막대기 | 2021.12.01 | 추천 0 | 조회 38
마른막대기 2021.12.01 0 38
24207 함수/공식
New 중복값 중 제일 마지막 값 추출 (2)
rladud99 | 2021.12.01 | 추천 0 | 조회 39
rladud99 2021.12.01 0 39
24203 함수/공식
New 엑셀 값 가로/세로 변경하는 방법 문의드려요! 첨부파일 (2) 답변완료
이시현 | 2021.12.01 | 추천 0 | 조회 38
이시현 2021.12.01 0 38
24200 함수/공식
New 데이터를 일정간격으로 띄워서 입력하고 싶습니다. (8) 답변완료
wlfl**** | 2021.12.01 | 추천 0 | 조회 47
wlfl**** 2021.12.01 0 47
24191 함수/공식
New 일치하는 값에 특정 데이터를 넣고싶습니다. (1)
노랑토끼 | 2021.12.01 | 추천 0 | 조회 54
노랑토끼 2021.12.01 0 54
24188 VBA
New VBA에서 이름이 긴 파일이 있는데 그 파일 이름을 바꾸고 싶습니다.(상세설명 필수) (2)
naver_618c988d51534 | 2021.12.01 | 추천 0 | 조회 31
naver_618c988d51534 2021.12.01 0 31
24184 문서서식
New 엑셀 자동채우기 관련 문의 (1) 답변완료
오문환 | 2021.12.01 | 추천 0 | 조회 42
오문환 2021.12.01 0 42
24182 함수/공식
New 줄바꿈 함수 도와주세요 첨부파일 (3)
김상준 | 2021.12.01 | 추천 1 | 조회 43
김상준 2021.12.01 1 43
24177 기능/도구
New 매크로 와 자동필터
FLOWERBALL | 2021.11.30 | 추천 0 | 조회 48
FLOWERBALL 2021.11.30 0 48
24168 VBA
New (문의) 번호가 같을경우 옆에 있는 셀의 값을 병합 (1)
ryan_cruze | 2021.11.30 | 추천 0 | 조회 44
ryan_cruze 2021.11.30 0 44
24166 기능/도구
New 질문있습니다.
최강씨맨 | 2021.11.30 | 추천 0 | 조회 34
최강씨맨 2021.11.30 0 34
24163 함수/공식
New 엑셀 특정 내용 추출하는 수식 질문드립니다. (2)
PAKSAW | 2021.11.30 | 추천 0 | 조회 52
PAKSAW 2021.11.30 0 52
24161 함수/공식
New 특정 날짜 값 찾기 (2)
ㄱ박민극 | 2021.11.30 | 추천 -1 | 조회 47
ㄱ박민극 2021.11.30 -1 47