해결

vba 속도 관련 질문드립니다.

더

6월 9일 조회 2,800

Sub Cal_gibon_Sigub()
Dim i As Long
Dim j As Long
Dim C As Range
Dim L As Range
Dim D As Range

Dim s1 As Double

Dim Maxval As Long

For i = 1 To 1000

Set C = ActiveSheet.Range("C8").Offset(i, 0)
ActiveSheet.Cells(8 + i, 3).Select

If IsEmpty(ActiveCell) Then
Exit For
End If

' Set k = ActiveSheet.Cells(1 + i, 3).Value
For j = 10 To 100000000 Step 50

ActiveSheet.Cells(i + 8, 4).Value = j
Set L = ActiveSheet.Range("L8").Offset(i, 0)
If L >= C Then
Exit For
End If
Next j

If L > C Then
Maxval = j
For s1 = j - 49.9 To Maxval Step 0.1
ActiveSheet.Cells(i + 8, 4).Value = s1
Set L = ActiveSheet.Range("L8").Offset(i, 0)
If L >= C Then
Exit For
End If
Next s1
End If

Next i

End Sub

허큘러스님 도움으로 오류는(For j = 1000 To 30000 Step 50 => 100000000 Dim j As Long) 해결했는데

회사 pc(인텔 펜티엄 / 8g램 / 엑셀 2019)에서 vba 실행하면 속도가 2-3초정도 걸리며 실행완료 되는데

집에 있는 노트북(i7-9750h / 16g램)에서 vba 실행하면 속도가 20~30초정도 걸리며 실행됩니다.

같은 vba인데 속도차이가 발생하는 이유가 알고 싶습니다.

또, 위의 명령문에서 속도를 빠르게 하기 위해서는 수정해야 할 부분이 있는지도 문의드립니다.

#VBA·매크로 #OFFSET 함수

더

더블유에이 6월 9일

Application.ScreenUpdating = false
 
Application.Calculation = xlCalculationManual
 
Application.EnableEvents = false
 
'명령문...
 
Application.ScreenUpdating = True
 
Application.Calculation = xlCalculationAutomatic
 
Application.EnableEvents = True

이렇게 작성해보세요

더

더운물 작성자 6월 9일

@더블유에이 님 제가 무지해서 답변해주신걸 이해 못했어요.

자세한 설명 부탁드려요

더

더블유에이 채택된 답변 6월 9일

@더운물 님

Sub Cal_gibon_Sigub()


Dim i As Long
Dim j As Long
Dim C As Range
Dim L As Range
Dim D As Range

Dim s1 As Double

Dim Maxval As Long

Application.ScreenUpdating = false

Application.Calculation = xlCalculationManual

Application.EnableEvents = false

For i = 1 To 1000

Set C = ActiveSheet.Range("C8").Offset(i, 0)
ActiveSheet.Cells(8 + i, 3).Select

If IsEmpty(ActiveCell) Then
Exit For
End If

' Set k = ActiveSheet.Cells(1 + i, 3).Value
For j = 10 To 100000000 Step 50

ActiveSheet.Cells(i + 8, 4).Value = j
Set L = ActiveSheet.Range("L8").Offset(i, 0)
If L >= C Then
Exit For
End If
Next j

If L > C Then
Maxval = j
For s1 = j - 49.9 To Maxval Step 0.1
ActiveSheet.Cells(i + 8, 4).Value = s1
Set L = ActiveSheet.Range("L8").Offset(i, 0)
If L >= C Then
Exit For
End If
Next s1
End If

Next i



Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True

End Sub

이렇게요

더

더운물 작성자 6월 9일

@더블유에이 님 정말 빠르네요

감사합니다 ^^

sinbal 6월 11일

@더블유에이 님 저는 저렇게 하는데도 시간이 빠르게 안되더라구요.

Sub sbProtectCells()

Dim wkbook As Workbook
Dim shtMain As Worksheet

Dim shtCnt As Long
Dim i As Long


Set shtMain = ThisWorkbook.Sheets("Main")

Workbooks.Open Filename:=shtMain.Cells(17, 3)

'셀에 나타난 주소의 파일 꺼내오기
Set wkbook = Application.ActiveWorkbook



shtCnt = wkbook.Sheets.Count

'파일의 시트 수 



Dim shtRng As Range
Dim nullrg As Range
Dim chCell As Range, cm As Range
On Error Resume Next


'빠른 매크로 위한 명령문
Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Application.EnableEvents = False

    


For i = 1 To shtCnt                                              '1부터 시트의 총 개수까지 반복
    
    With Sheets(i)
    .Unprotect
    
    Set shtRng = .UsedRange
        With shtRng
        .Cells.Locked = True
        .SpecialCells(xlCellTypeBlanks).Locked = False    ' 빈 셀이 있으면 잠금 해제
        End With
        For Each chCell In shtRng.Cells   
            If chCell.mergeCells Then                         '동적 범위 내에 병합셀이 있다면
                Set cm = chCell.MergeArea                  '병합 영역으로 설정
                cm.Locked = Not IsEmpty(cm.Cells(1))    '병합셀 내부에 값이 있다면 잠금 설정
            End If
        Next chCell
    .Protect                                                       '전체 시트 보호
    End With
    
Next i




wkbook.Close True


Set wkbook = Nothing
Set shtRng = Nothing
Set nullrg = Nothing


Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

Application.EnableEvents = True