[스크랩] 내역 행삽입 및 삭제
1.당초내역
2.변경내역(행삽입)
3.주의사항
4.UserForm Source : UserForm3
※추가기능설치 : http://blog.daum.net/termious/3
Private Sub UserForm_Initialize()
With Me
.Caption = "행삽입 및 삭제"
.RefEdit1 = Selection.Address
.Height = 95
.ToggleButton1.BackColor = &HC0E0FF
End With
End Sub
Sub CommandButton1_Click()
'Dim cmdbtn1 As Boolean
'Dim cmdbtn2 As Boolean
cmdbtn1 = True
cmdbtn2 = False
Call 열추가및삭제(cmdbtn1, cmdbtn2)
End Sub
Sub CommandButton2_Click()
'Dim cmdbtn1 As Boolean
'Dim cmdbtn2 As Boolean
cmdbtn1 = False
cmdbtn2 = True
Call 열추가및삭제(cmdbtn1, cmdbtn2)
End Sub
Private Sub ToggleButton1_Click()
On Error Resume Next
Dim meTop As Single
Dim meHeight As Single
Dim me_First_Center As Single
Dim me_Second_Center As Single
Dim me_First_Height As Single
Dim me_SeCond_Height As Single
Dim i%
me_First_Height = 280
me_SeCond_Height = 95
If ToggleButton1.Value = False Then
'Userform3의 화면윗쪽 기준 간격.
meTop = UserForm3.Top
meHeight = UserForm3.Height / 2
me_First_Center = meTop + meHeight
'Userform3의 높이을 변경
UserForm3.Height = me_SeCond_Height
'Userform3의 높이 변경에 대한 화면 위쪽 기준 간격.
meHeight = UserForm3.Height / 2
me_Second_Center = meTop + meHeight
'화면의 중앙으로 Userform3을 이동
UserForm3.Top = (meTop - (me_Second_Center - me_First_Center))
UserForm3.ToggleButton1.Caption = "▼▼"
Else
'Userform3의 높이을 변경
UserForm3.Height = me_First_Height
'Userform3의 화면 위쪽 기준 간격.
meTop = UserForm3.Top
meHeight = UserForm3.Height / 2
me_First_Center = meTop + meHeight
me_Second_Center = (meTop + me_SeCond_Height / 2)
'화면의 중앙으로 Userform3을 이동
UserForm3.Top = (meTop + (me_Second_Center - me_First_Center))
UserForm3.ToggleButton1.Caption = "▲▲"
End If
Me.RefEdit1.SetFocus
End Sub
Sub 열추가및삭제(cmdbtn1, cmdbtn2)
On Error Resume Next
Dim SelRange As Range
Dim CellGroup As Integer
'Dim RowCnt As Single
'Dim RngRow As Single
'Dim RngCol As Integer
'Dim RngColCnt As Single
'Dim RngRowCntAdd As Single 'MyShoetKey로 정의됨
Application.ScreenUpdating = False
'Get the address, or reference, from the RefEdit control.
'Set the SelRange Range object to the range specified in the RefEdit control.
Set SelRange = Range(RefEdit1.Value)
If RefEdit1.Value <> "" And SelRange.Areas.Count < 0 Then
MsgBox "행삽입 및 삭제할 영역이 선택되지 않았습니다", , "^^,"
Exit Sub
End If
For CellGroup = SelRange.Areas.Count To 1 Step -1
With SelRange
RngRow = .Areas(CellGroup).Cells(1, 1).Row
RngCol = .Areas(CellGroup).Cells(1, 1).Column
RngRowCntAdd = .Areas(CellGroup).Rows.Count
RngColCnt = .Areas(CellGroup).Columns.Count
If cmdbtn1 = True Then
RefEdit1.Value = Range(Cells(RngRow, RngCol), Cells(RngRow + (RngRowCntAdd * 2 - 1), RngCol + RngColCnt - 1)).Address
Range(Cells(RngRow, RngCol), Cells(RngRow + (RngRowCntAdd * 2 - 1), RngCol + RngColCnt - 1)).Select
For RowCnt = RngRowCntAdd To 1 Step -1
Call 당초_소집계_수식수정(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
.Areas(CellGroup).Rows(RowCnt).Copy
.Areas(CellGroup).Rows(RowCnt).Insert Shift:=xlDown
If RowCnt = 1 Then RowCnt = 0
Call 변경_소집계_수식수정(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
.Areas(CellGroup).Rows(RowCnt).Font.ColorIndex = 3
.Areas(CellGroup).Rows(RowCnt).Borders(xlEdgeBottom).LineStyle = xlNone
UserForm3.Hide
Call MyShortKey.ShowUserProgressBarForm 'UserForm9.Show
Next
ElseIf cmdbtn2 = True Then
RefEdit1.Value = Range(Cells(RngRow, RngCol), Cells(RngRow + (RngRowCntAdd / 2 - 1), RngCol + RngColCnt - 1)).Address
Range(Cells(RngRow, RngCol), Cells(RngRow + (RngRowCntAdd / 2 - 1), RngCol + RngColCnt - 1)).Select
For RowCnt = RngRowCntAdd To 1 Step -2
Call 당초_sum함수로변경_수식수정(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
.Areas(CellGroup).Rows(RowCnt - 1).Delete Shift:=xlUp
UserForm3.Hide
Call MyShortKey.ShowUserProgressBarForm 'UserForm9.Show
Next
'.Borders(xlEdgeLeft).Weight = xlThin
'.Borders(xlEdgeTop).Weight = xlThin
'.Borders(xlEdgeBottom).Weight = xlThin
'.Borders(xlEdgeRight).Weight = xlThin
'.Borders(xlInsideVertical).Weight = xlThin
'.Borders(xlInsideHorizontal).Weight = xlThin
End If
End With
Next CellGroup
iNumber = 0
RngColCnt = 0
RngRowCntAdd = 0
Unload UserForm9
Application.ScreenUpdating = True
UserForm3.Show
Me.RefEdit1.SetFocus
End Sub
Sub 당초_소집계_수식수정(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
Dim sTrwhat As String
Dim sTemp As String
Dim sResult As Variant
Dim iStr As Single
Dim jStr As Single
On Error Resume Next
With SelRange
For RngCol = RngColCnt To 1 Step -1
'문장내 "SUM"이 있다면,
If .Areas(CellGroup).Cells(RowCnt, RngCol).Find(What:="SUM") Is Nothing Then GoTo daum
'문장내 ","가 있다면,
sResult = ""
sTrwhat = .Areas(CellGroup).Cells(RowCnt, RngCol).Formula
For iStr = 1 To Len(sTrwhat)
sTemp = Mid(sTrwhat, iStr, 1)
If sTemp = "," Then
Call 현재셀_합연산수식으로변경(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
Call 현재셀_SUM함수식으로변경(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
Exit For
End If
Next iStr
'문장내 "SUM"을 "hap"합수로 교체
sResult = ""
sTrwhat = .Areas(CellGroup).Cells(RowCnt, RngCol).Formula
For iStr = 1 To Len(sTrwhat)
sTemp = Mid(sTrwhat, iStr, 3)
If sTemp = "SUM" Then
sResult = sResult & "hap"
iStr = iStr + 3
End If
If ")" = Mid(sTrwhat, iStr, 1) Then
sResult = sResult & ",""B"""
End If
sResult = sResult & Mid(sTrwhat, iStr, 1)
Next iStr
.Areas(CellGroup).Cells(RowCnt, RngCol).Formula = sResult
daum:
Next RngCol
End With
End Sub
Sub 현재셀_합연산수식으로변경(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
On Error Resume Next
Dim sResult As Variant
Dim PlusRng As String
Dim sTrwhat As String
Dim sTemp As String
Dim strRange As Range
Dim eRange As Range
With SelRange
sResult = ""
PlusRng = ""
sTrwhat = .Areas(CellGroup).Cells(RowCnt, RngCol).Formula
For iStr = 1 To Len(sTrwhat)
sTemp = Mid(sTrwhat, iStr, 3)
If sTemp = "SUM" Then
sResult = sResult & ""
iStr = iStr + 3
End If
sResult = sResult & Mid(sTrwhat, iStr, 1)
Next iStr
'복합영역에 대해 range로 인식을 못하고 있음.
Set strRange = Range(sResult)
For Each eRange In strRange
PlusRng = PlusRng & "+" & Chr(64 + .Areas(CellGroup).Cells(RowCnt, RngCol).Column) & eRange.Row
Next eRange
.Areas(CellGroup).Cells(RowCnt, RngCol).Formula = "=" & PlusRng
'참조되는 셀추적
.ShowPrecedents
End With
End Sub
Sub 현재셀_SUM함수식으로변경(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
On Error Resume Next
Dim sTrwhat As String
Dim eRange
Dim tRange()
Dim aa As Integer
Dim iStr As Integer
Dim dCnt As Integer
Dim BP As String
Dim EP As String
With SelRange
sResult = ""
dCnt = 0
sTrwhat = .Areas(CellGroup).Cells(RowCnt, RngCol).Formula
For iStr = 1 To Len(sTrwhat)
sTemp = Mid(sTrwhat, iStr, 1)
If sTemp = "=" Then
sResult = sResult & ""
iStr = iStr + 2
End If
If sTemp = "+" Or iStr = Len(sTrwhat) Then
If iStr = Len(sTrwhat) Then sResult = sResult & Mid(sTrwhat, iStr, 1)
dCnt = dCnt + 1
ReDim Preserve tRange(1 To dCnt)
tRange(dCnt) = sResult
sResult = ""
iStr = iStr + 1
End If
sResult = sResult & Mid(sTrwhat, iStr, 1)
Next iStr
End With
BP = tRange(LBound(tRange))
EP = tRange(UBound(tRange))
SelRange.Areas(CellGroup).Cells(RowCnt, RngCol).Formula = "=sum(" & BP & ":" & EP & ")"
'참조되는 셀추적
SelRange.ShowPrecedents
End Sub
Sub 변경_소집계_수식수정(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
On Error Resume Next
Dim sTrwhat As String
Dim sTemp As String
Dim sResult As Variant
Dim iStr As Single
Dim jStr As Single
With SelRange
For RngCol = RngColCnt To 1 Step -1
If .Areas(CellGroup).Cells(RowCnt, RngCol).Find(What:="hap") Is Nothing Then GoTo daum
sResult = ""
sTrwhat = .Areas(CellGroup).Cells(RowCnt, RngCol).Formula
For iStr = 1 To Len(sTrwhat)
sTemp = Mid(sTrwhat, iStr, 1)
If sTemp = "B" Then
sResult = sResult & "R"
iStr = iStr + 1
End If
sResult = sResult & Mid(sTrwhat, iStr, 1)
Next iStr
.Areas(CellGroup).Cells(RowCnt, RngCol).Formula = sResult
daum:
Next RngCol
End With
End Sub
Sub 당초_sum함수로변경_수식수정(SelRange, CellGroup, RowCnt, RngCol, RngColCnt)
On Error Resume Next
Dim sTrwhat As String
Dim sTemp As String
Dim sResult As Variant
Dim iStr As Single
Dim jStr As Single
With SelRange
For RngCol = RngColCnt To 1 Step -1
If .Areas(CellGroup).Cells(RowCnt, RngCol).Find(What:="hap") Is Nothing Then GoTo daum
sResult = ""
sTrwhat = .Areas(CellGroup).Cells(RowCnt, RngCol).Formula
For iStr = 1 To Len(sTrwhat)
sTemp = Mid(sTrwhat, iStr, 3)
If sTemp = "hap" Then
sResult = sResult & "sum"
iStr = iStr + 3
End If
If ",""B""" = Mid(sTrwhat, iStr, 4) Then
sResult = sResult & ""
iStr = iStr + 4
End If
sResult = sResult & Mid(sTrwhat, iStr, 1)
Next iStr
.Areas(CellGroup).Cells(RowCnt, RngCol).Formula = sResult
daum:
Next RngCol
End With
End Sub