| |
* 답변하시는 분들께 도움이 되도록 자신의 환경을 아래 항목 옆에 기재해 주세요.
- 엑셀 버전(95,97,2000,xp,2003,2007):
* 아래줄에 질문을 작성하세요 >>
아래 코드로 데이타 처리시 처리 속도가 늦어
속도를 개선 할 수 있는 방법이 있는지 궁금합니다
감사합니다
Sub TEST()
Dim ST As Integer
Dim DT As Integer
Sheets("수합").Select
Range("A2:Y1000").Select
Selection.ClearContents
Application.ScreenUpdating = False
For ST = 1 To 250
'---------------------------------------
With Application
.Calculation = xlManual
.MaxChange = 0.001
End With
'---------------------------------------
Sheets("내역").Select
If Range("P12") = 1 Then
Range("L12:P12").Copy
Sheets("수합").Select
DT = Range("B1").Value
Range("A" & DT).Select
ActiveSheet.Paste
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
ElseIf Range("P12") = 2 Then
Range("L12:P12").Copy
Sheets("수합").Select
DT = Range("G1").Value
Range("F" & DT).Select
ActiveSheet.Paste
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
ElseIf Range("P12") = 3 Then
Range("L12:P12").Copy
Sheets("수합").Select
DT = Range("L1").Value
Range("K" & DT).Select
ActiveSheet.Paste
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
ElseIf Range("P12") = 4 Then
Range("L12:P12").Copy
Sheets("수합").Select
DT = Range("Q1").Value
Range("P" & DT).Select
ActiveSheet.Paste
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
ElseIf Range("P12") = 5 Then
Range("L12:P12").Copy
Sheets("수합").Select
DT = Range("V1").Value
Range("U" & DT).Select
ActiveSheet.Paste
ActiveSheet.PasteSpecial Format:=3, Link:=1, DisplayAsIcon:=False, _
IconFileName:=False
Else
End If
Sheets("내역").Select
Range("B4:E3500").Copy
Range("B3").PasteSpecial (3)
'-----------------------------------------
With Application
.Calculation = xlAutomatic
.MaxChange = 0.001
End With
'-------------
Next ST
Application.ScreenUpdating = True
End Sub
==============[새로운 삶님 글에 대한 답변입니다]==============
==============[새로운 삶님 글에 대한 답변입니다]==============
첨부화일 참고하세요
Sub TEST_Ans()
Dim ST As Integer
Dim DT As Integer
Dim wstA As Worksheet, wstB As Worksheet, wstC As Worksheet
Dim rTg As Range
Dim vX
Set wstA = Sheets("내역")
Set wstB = Sheets("수합")
wstB.Range("A2:Y1000").ClearContents
With Application
.ScreenUpdating = False
.EnableEvents = False
'.Calculation = xlCalculationManual
End With
For ST = 1 To 250
vX = wstA.Range("L12:P12").Value
If wstA.Range("P12") = 1 Then
DT = wstB.Range("B1").Value
Set rTg = wstB.Range("A" & DT)
ElseIf wstA.Range("P12") = 2 Then
DT = wstB.Range("G1").Value
Set rTg = wstB.Range("F" & DT)
ElseIf wstA.Range("P12") = 3 Then
DT = wstB.Range("L1").Value
Set rTg = wstB.Range("K" & DT)
ElseIf wstA.Range("P12") = 4 Then
DT = wstB.Range("Q1").Value
Set rTg = wstB.Range("P" & DT)
ElseIf wstA.Range("P12") = 5 Then
DT = wstB.Range("V1").Value
Set rTg = wstB.Range("U" & DT)
Else
Set rTg = Nothing
End If
If Not rTg Is Nothing Then
rTg.Resize(UBound(vX, 1), UBound(vX, 2)) = vX
End If
vX = wstA.Range("B4:E3500").Value
wstA.Range("B3").Resize(UBound(vX, 1), UBound(vX, 2)) = vX
Next ST
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub |
|
엑셀에 대한 질문과
답변을 올려주세요. 단, 취지에 맞지 않는 글은 운영자가 삭제합니다.
