활성화셀을 기준으로 지정 셀만큼 셀위치 활성화

Sub Test()


    ActiveCell.Resize(31, 14).Select

End Sub

Posted by 조용문

Sub Find_Macro()
    mystring = "mystring"
    Set RangeObj = Cells.Find(What:=mystring, After:=ActiveCell, _
    LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
    SearchDirection:=xlNext, MatchCase:=False)
    If RangeObj Is Nothing Then MsgBox "Not Found" Else RangeObj.Select
End Sub

Posted by 조용문

lookin:=xlformulas    << 수식에서
lookin:=xlvaues    << 값에서
LookIn:=xlComments    << 메모에서

위 사진에서 찿는 위치를 메모로 하고 메크로 기록을 하면...

    Cells.Find(What:="홍길동", After:=ActiveCell, LookIn:=xlComments, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , MatchByte:=False, SearchFormat:=False).Activate

이렇게 기록 되지만...

실제 사용하는 건 보통 아래 코드를 많이 사용 합니다. xlvaues 는 보통 생략

Set rngA = Cells.Find(what:="홍길", lookat:=xlPart)    '// 포함된 셀을 찿음

Set rngA = Cells.Find(what:="홍길동", lookat:=xlWhole)   '// 내용이 정확히 일치하는 셀을 찿음

하지만 수식이나, 메모에서 찿고자 한다면 지정해 주어야 합니다.

Posted by 조용문

한 셀의 내용을 그 다음 4칸에 복사하는 작업을 반복한다.

빈셀이 나타나면 중지한다.

Sub Macro3()

Do While ActiveCell.FormulaR1C1 <> "" '빈셀이 아닌동안 아래 열을 실행하고 빈셀이면 빠져나간다

Selection.Copy '현재셀을 복사
ActiveCell.Offset(1, 0).Range("A1").Select '한칸 아래로 이동
Range(Selection, Selection.End(xlDown)).Select '다음 내용이 있는 곳까지 선택
ActiveCell.Range("A1:A4").Select '4개의 칸을 선택
ActiveSheet.Paste '선택한 4개 칸에 복사해넣기
ActiveCell.Offset(4, 0).Range("A1").Select '다음 네 칸 이동

Loop

End Sub
Posted by 조용문

엑셀에서의 암호설정

2011. 9. 3. 12:01

'C 드라이브의 시리얼을 확인해서 틀리면 파일을 닫습니다..
Sub Auto_Open()
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.GetDrive("C:\").SerialNumber = "5736354" Then
Else
ThisWorkbook.Close
' Application.Quit
End If
End Sub

'시리얼을 알아내려면 다음 코드를 실행
Sub GetSerial()
Dim objFSO As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
MsgBox objFSO.GetDrive("C:\").SerialNumber
End Sub

Posted by 조용문






Sub hyper()

Dim NameArea As Range
Dim AddressArea As Range

On Error GoTo g1: ' 범위 입력이 없을 경우 나감

Set NameArea = Application.InputBox("하이퍼링크 만들범위", Title:="범위선택", Type:=8)
Set AddressArea = Application.InputBox("주소범위", Title:="범위선택", Type:=8)


NameArea.Select

maxi = Selection.Count
cnt = 1

For Each c In AddressArea
If cnt > maxi Then

Exit Sub

Else

sitename = Selection(cnt)
sitenameAdd = Selection(cnt).Address
addss = ".\" & c
ActiveSheet.Hyperlinks.Add Anchor:=Range(sitenameAdd), Address:=addss, TextToDisplay:=sitename

cnt = cnt + 1

End If
Next

g1:

End Sub


Posted by 조용문

=ConcatText(Sheet1!A1:A3,A1,Sheet1!B1:B3)


Function ConcatText(범위1, 조건, 범위2) As String
Dim strTemp() As String
Dim rng As range
Dim i As Integer, n As Integer
n = 범위2.Column - 범위1.Column
For Each rng In 범위1
If rng = 조건 Then
ReDim Preserve strTemp(i)
strTemp(i) = rng.Offset(, n)
i = i + 1
End If
Next rng
ConcatText = Join(strTemp, ",")
End Function





만약 조건이 2개일때..

=ConcatText(N2:N9999,C5,Y2:Y9999,B5,2:I9999)
(설명) 범위1, 조건1, 범위2, 조건2, 표시값


Option Explicit

Function ConcatText(범위1, 값1, 범위2, 값2, 범위3) As String
 Dim strTemp() As String
 Dim rng As Range
 Dim i As Integer
 
 For Each rng In 범위1
 If rng = 값1 Then
  If rng.Offset(, 범위2.Column - 범위1.Column) = 값2 Then
  ReDim Preserve strTemp(i)
    strTemp(i) = rng.Offset(, 범위3.Column - 범위1.Column).Value
    i = i + 1
   End If
 End If
  Next rng
 ConcatText = Join(strTemp, ", ")
End Function

 

 

Posted by 조용문

매크로 셀이동

2011. 6. 14. 23:52

ActiveCell은 현재 활성화된 셀(선택된셀) 입니다.

ActiveCell.Offset(0, 1).Select
ActiveCell.Offset(0, 5).Select
ActiveCell.Offset(1, 5).Select
ActiveCell.Offset(3, 0).Select
ActiveCell.End(2).Select

1)현재 셀을 기준으로
"현재 셀 + 현재 셀과 데이터가 아래 방향으로 연속된 셀의 마지막 셀까지의 범위"를 선택합니다. 단축키의 "Ctrl+Shift+ 아래
방향키"와 같은 기능
Range(ActiveCell, activeCell.End(xlDown)).Select
2)"현재 셀 + 현재 셀의 데이터가 연속된 위쪽 방향의 마지막
셀 범위"를 선택합니다.
단축키의 "Ctrl+Shift+ 위 방향키"와 같은 기능
Range(ActiveCell, activeCell.End(xlUp)).Select
3)"현재 셀 + 현재 셀의 데이터가 연속된 오른쪽 방향의 마지막 셀
범위"를 선택합니다.
Range(ActiveCell, activeCell.End(xlToRight)).Select
4)"현재 셀 + 현재 셀의 데이터가 연속된 왼쪽 방향의
마지막 셀 범위"를 선택합니다.
Range(ActiveCell, activeCell.End(xlToLeft)).Select
5) 현재 셀과 현재 셀의 인접한 셀 범위를 선택합니다. 현재
셀에서 떨어지 영역은 선택할 수 없음.
ActiveCell.CurrentRegion.Select
6) 현재
셀과 시트의 마지막 셀을 범위로 선택합니다.
Range(Range("A1"), activeCell.SpecialCells(xlLastCell)).Select
7) 현재 셀을 기준으로 열 방향으로
데이터가 있는 셀 범위를 선택하는 매크로
" 현재 셀이 빈 셀이면 프로시저를 종료
If IsEmpty(ActiveCell) then Exit Sub
" 에러가 발생해도 계속 코드를 진행시킨다.
On Error Resume Next
"
현재 셀의 바로 위쪽 셀(offset(-1,0))이 빈셀이면 현재 셀을 가장 위에 위치한 셀로 지정한다. 만약 바로 위쪽 셀에 데이터가
있다면 end(xlup)속성으로 가장 위쪽의 셀을 지정한다. 지정한 셀은 변수 TopCell에 참조됨
If isEmpty(ActiveCell.Offset(-1, 0)) Then
Set TopCell = activeCell
Else
Set TopCell = ActiveCell.End(xlUp)
End If
" 현재
셀의 바로 아래쪽 셀이 빈셀이면 현재 셀을 가장 아래 쪽에 있는 셀로 지정한다. 아니면 현재셀의 가장 아래 쪽 셀 end(xldown)를
선택해 지정한다.
"지정한 셀은 변수 BottomCell에 참조됨
If IsEmpty(ActiveCell.Offset(1,
0)) Then
Set BottomCell = ActiveCell
Else
Set BottomCell = activeCell.End(xlDown)
End If
" 변수의 범위를 선택한다.
" 현재 셀을 기준으로 열의
데이터가 있는 셀 범위가 선택됨
Range(TopCell, BottomCell).Select
8) 현재 셀을
기준으로 데이터가 있는 행 방향의 셀 범위를 선택하는 매크로
" 현재 셀이 빈 셀이면 프로시저를 종료
If isEmpty(ActiveCell) Then Exit Sub
" 에러가 발생해도 계속 코드를 진행시킨다
On Error resume Next
" 현재 셀의 왼쪽 셀이 빈 셀이면 현재 셀을 가장 왼쪽 셀로 지정한다.
" 아니면
end(xltoright) 속성으로 가장 왼쪽 셀을 선택하여 변수에 지정한다.
If isEmpty(ActiveCell.Offset(0, -1)) Then
Set LeftCell = activeCell
Else
Set LeftCell = ActiveCell.End(xlToLeft)
End if
" 현재 셀의 오른쪽 셀이 빈 셀이면 현재 셀을 가장 오른쪽 셀로 지정한다.
" 아니면 end(xltoright)
속성으로 가장 오른쪽 셀을 선택하여 변수에 지정한다.
If IsEmpty(ActiveCell.Offset(0, 1)) then
Set RightCell = ActiveCell
Else
Set RightCell = activeCell.End(xlToRight)
End If
" 변수로 지정한 셀 범위를
선택한다.
Range(LeftCell, RightCell).Select
9) 현재 셀의
열(entirecolun)을 선택한다.
Selection.EntireColumn.Select
10) 현재
셀의 행(entirerow)를 선택한다.
Selection.EntireRow.Select
11) 현재 셀을
기준으로 아래 방향의 첫 번째 빈 셀을 선택하는 매크로
" 현재 셀의 아래 셀을 선택한다(활성 셀이
된다)
ActiveCell.Offset(1, 0).Select
" Do while 순환문은 조건이 참(True)인 동안만
순환된다.
" 조건을 현재셀이 빈 셀이 아니면 계속 순환하도록 지정한다.
" 순환문의 내부에 있는 실행문에서 계속 다음의 셀을
선택하도록 하여 현재 셀의 위치를 변경시켜준다.
Do While Not isEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
" 순환문이
종료되었다면 선택된 셀은 빈 셀이다.
12) 현재 셀에서 열 방향으로 빈 셀을 찾는 매크로(오른쪽 방향)
"
11번의 문에서 Offset의 위치만 열 방향으로 변경시켜 준다.
ActiveCell.Offset(0,
1).Select
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(0,
1).Select
Loop
13) 행에 데이터가 있는 첫번째 셀과 마지막 셀의 범위를 선택하는 매크로
" 현재
셀의 행번호에 열번호를 1로 지정하여 가장 왼쪽 셀로 변수에 참조한다.
" 현재 셀이 어떤 셀이든 항상 A열을
참조하게된다.
Set LeftCell = Cells(ActiveCell.Row, 1)
" 현재 셀의 행번호에 열번호를
256로 지정하여 가장 오른쪽 셀로 변수에 참조한다.
" 현재 셀이 어떤 셀이든 항상 IV열을 참조한다.
Set RightCell
= Cells(ActiveCell.Row, 256)
" 만약 변수가 참조하는 셀이 빈 셀이면 데이터가 있는 가장 왼쪽의 셀이
아니다.
" 따라서 다시 셀을 찾아서 참조한다: end(xltoright)
If IsEmpty(LeftCell) then
Set LeftCell = LeftCell.End(xlToRight)
End If
" 마찬가지로 가장 오른쪽
셀을 참조하는 셀이 빈셀이면 데이터가 있는 가장 오른쪽 셀이 아니다.
" 따라서 다시 셀을 찾아서 참조한다: end(xltoleft)
If IsEmpty(RightCell) Then
Set RightCell = rightCell.End(xlToLeft)
End If
" 가장 왼쪽 셀의 열 번호가 256이면서 가장 오른쪽 셀의 열
번호가 1이면 현재 셀만 데이터가 있는 유일한 셀이된다.
" 그렇지 않다면 변수가 참조하는 셀 범위를 선택한다.
If leftCell.Column = 256 And RightCell.Column = 1 then
ActiveCell.Select
Else
Range(LeftCell, RightCell).Select
End if
14) 열에 데이터가 있는 첫번째 셀과 마지막 셀의 범위를 선택하는 매크로
" 13번의 설명을
참고하세요
" 셀을 선택하는 방향만 틀립니다.
Set TopCell = Cells(1, activeCell.Column)
Set BottomCell = Cells(16384, activeCell.Column)
If IsEmpty(TopCell) Then
Set TopCell = topCell.End(xlDown)
End If
If IsEmpty(BottomCell) Then
Set bottomCell = BottomCell.End(xlUp)
End If
If TopCell.Row = 16384 And bottomCell.Row = 1 Then
ActiveCell.Select
Else
Range(TopCell, bottomCell).Select
End If

Posted by 조용문

아래의 예제는 선택한 셀의 주소 값을 알아내는 예제입니다.
엑셀을 실행한 후, 셀의 아무 곳이나 선택하고, 매크로를 실행하면
선택한 셀의 주소를 메세지 박스로 보여주고,
a1 주소로 이동했다가 다시 원래 셀로 돌아가는 매크로입니다..

Sub CellMove_TEST()

Dim imaVal As String ' 현재선택된셀의 Address 값

imaVal = ActiveCell.Address ' 현재 값을 변수로 받는다.
MsgBox (imaVal) ' 값 확인

Application.ActiveSheet.Range("a1").Select ' a1 셀로 이동
Application.ActiveSheet.Range(imaVal).Select ' 처음 입력 받은 셀로 다시 이동

End Sub

Posted by 조용문

엑셀에서 같은 셀 안의 내용을
1. 맞춤법 순으로 정렬을 하고,
2. 중복된 값을 하나만 놔두고 지우기

한 셀 내의 문자를 구분자 구분하여 나눠서 중복제거를 한 다음 정렬한 코드입니다.
사용법은 셀 주소와 구분자를 표시하면 됩니다.

Function TxtSort(strR As Variant, strC As Variant) As Variant
'strR 은 정렬을 할 셀 선택
'strC 는 셀 구분자를 입력
Dim NC          As New Collection
Dim strTxt      As Variant
Dim temp        As Variant
Dim cnt         As Integer
Dim i           As Integer
Dim j           As Integer
cnt = (Len(strR) - Len(Application.WorksheetFunction.Substitute(strR, strC, ""))) / Len(strC)
ReDim strTxt(1 To cnt + 1)
For i = 1 To cnt
strTxt(i) = Left(strR, InStr(1, strR, strC) - 1)
strR = Mid(strR, Len(strTxt(i)) + Len(strC) + 1, Len(strR) - (Len(strTxt(i)) + Len(strC)))
Next i
strTxt(cnt + 1) = strR
On Error Resume Next
cnt = cnt + 1
For i = 1 To cnt
NC.Add strTxt(i), strTxt(i)
Next i
On Error GoTo 0
ReDim temp(NC.Count)
cnt = NC.Count
For i = 1 To cnt
For j = 1 To cnt
If NC(i) >= NC(j) Then
temp(i) = temp(i) + 1
End If
Next j
Next i
ReDim strTxt(NC.Count)
For i = 1 To cnt
strTxt(temp(i)) = NC(i)
Next
strR = strTxt(1)
For i = 2 To cnt
strR = strR & strC & strTxt(i)
Next
TxtSort = strR
End Function
Posted by 조용문

BLOG main image
by 조용문

공지사항

카테고리

분류 전체보기 (66)
사진 (7)
흙건축 (14)
스틸하우스 (9)
D.I.Y (6)
프로그램 (0)
이동통신 (6)
농업 (1)
IoT (8)
엑셀VBA (13)

최근에 올라온 글

최근에 달린 댓글

최근에 받은 트랙백

태그목록

글 보관함

달력

«   2024/05   »
1 2 3 4
5 6 7 8 9 10 11
12 13 14 15 16 17 18
19 20 21 22 23 24 25
26 27 28 29 30 31
Total :
Today : Yesterday :