한 자리 숫자 입력 후 다음 셀로 이동

VBA
작성자
호미니
작성일
2021-06-07 16:31
조회
45

안녕하세요.

설문지 응답 내용을 입력하려고 하는데 일정한 범위의 숫자를 입력하면 엔터를 누르지 않아도 다음 셀로 넘어가도록 할 수 있을까요?

예를 들어, 1혹은 2로 응답하는 설문지가 있을 때 1 혹은 2를 입력하거나 한 자리 숫자를 입력하면 엔터를 누르지 않아도 아래 셀로 넘어갈 수 있도록 만들고 싶습니다.

회원등급 : 새싹등급
포인트 : 54 EP
총질문 : 1 개 (마감율 : 100%)
채택답변 : 0 개
전체 2

  • 2021-06-11 06:23

    우와... 신세계입니다 ㅠ


  • 2021-06-07 17:33
    채택된 답변

    Worksheet에 KeyPress Event를 임의로 주입 시켜야 가능합니다.

    아래 API 코드를 참조해서 해보세요.

    Option Explicit
    
    Private Type POINTAPI
        x As Long
        y As Long
    End Type
    
    Private Type MSG
        hwnd As Long
        Message As Long
        wParam As Long
        lParam As Long
        time As Long
        pt As POINTAPI
    End Type
    
    
    Private Declare Function WaitMessage Lib "user32" () As Long
    
    Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" _
        (ByRef lpMsg As MSG, ByVal hwnd As Long, _
         ByVal wMsgFilterMin As Long, _
         ByVal wMsgFilterMax As Long, _
         ByVal wRemoveMsg As Long) As Long
    
    Private Declare Function TranslateMessage Lib "user32" _
        (ByRef lpMsg As MSG) As Long
    
    Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
        (ByVal hwnd As Long, _
         ByVal wMsg As Long, _
         ByVal wParam As Long, _
         lParam As Any) As Long
    
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
        (ByVal lpClassName As String, _
         ByVal lpWindowName As String) As Long
    
    Private Const WM_KEYDOWN As Long = &H100
    Private Const PM_REMOVE  As Long = &H1
    Private Const WM_CHAR    As Long = &H102
    Private bExitLoop As Boolean
    
    
    Public pTemp As String
    Public GlobalArray As Variant
    
    
    Sub TrackKeyPressInit()
    
        Dim msgMessage As MSG
        Dim bCancel As Boolean
        Dim iKeyCode As Integer
        Dim lXLhwnd As Long
        GlobalArray = Array(19, 20, 46, 40, 35, 13, 27, 36, 45, 37, 144, 34, 33, 39, 145, 9, 38)
            'BACKSPACE  8
            'BREAK  19
            'CAPS LOCK  20
            'DELETE 46
            'DOWN ARROW 40
            'END    35
            'ENTER 13
            'ESC    27
            'HOME   36
            'INS    45
            'LEFT ARROW 37
            'NUM LOCK   144
            'PAGE DOWN  34
            'PAGE UP    33
            'RIGHT ARROW    39
            'SCROLL LOCK    145
            'TAB    9
            'UP ARROW   38
        On Error GoTo errHandler:
            Application.EnableCancelKey = xlErrorHandler
            bExitLoop = False
            lXLhwnd = FindWindow("XLMAIN", Application.Caption)
        Do
            WaitMessage
            If PeekMessage _
                (msgMessage, lXLhwnd, WM_KEYDOWN, WM_KEYDOWN, PM_REMOVE) Then
                iKeyCode = msgMessage.wParam
                TranslateMessage msgMessage
                PeekMessage msgMessage, lXLhwnd, WM_CHAR, WM_CHAR, PM_REMOVE
                If iKeyCode = vbKeyBack Then SendKeys "{BS}"
                'If iKeyCode = vbKeyReturn Then SendKeys "{ENTER}"
                bCancel = False
                Sheet_KeyPress ByVal msgMessage.wParam, ByVal iKeyCode, ByVal Selection, bCancel
                If bCancel = False Then
                    PostMessage lXLhwnd, msgMessage.Message, msgMessage.wParam, 0
                End If
            End If
    errHandler:
            DoEvents
        Loop Until bExitLoop
    
    End Sub
    
    Sub StopKeyWatch()
        bExitLoop = True
    End Sub
    
    Private Sub Sheet_KeyPress(ByVal KeyAscii As Integer, _
                               ByVal KeyCode As Integer, _
                               ByVal Target As Range, _
                               Cancel As Boolean)
    
        If Not Intersect(Target, Range("A1:D10")) Is Nothing Then
            If IsInArray(KeyAscii, GlobalArray) Then
                StopKeyWatch ' exit if pressed key in globalscope (restricted)
                Cancel = True
                SendKeys "{ENTER}" ' UPDATE CELL
            Else
                pTemp = pTemp & Chr(KeyAscii)
                   Target.Offset(0) = pTemp
                   Target.Offset(1) = pTemp
                Cancel = True
                Application.ScreenUpdating = True
            End If
        Else
            StopKeyWatch
        End If
    
    End Sub

     


전체 3,238
번호 카테고리 제목 작성자 작성일 추천 조회
3225 VBA
New 네이버 API 이용 검색관련 질문좀요. (1)
녹색태양 | 02:30 | 추천 0 | 조회 15
녹색태양 02:30 0 15
3224 함수/공식
New 이름 중복자도 추출하는 방법... 첨부파일 (2) 답변완료
승재빠 | 2021.06.17 | 추천 0 | 조회 31
승재빠 2021.06.17 0 31
3223 함수/공식
New 다중조건 목록상자(드롭다운)에서 열참조가 아닌 행참조로 하는 방법이 있을까요?
치즈쿠키 | 2021.06.17 | 추천 0 | 조회 18
치즈쿠키 2021.06.17 0 18
3222 VBA
New INDEX,MATCH 함수로 불러온 값에 배경색까지 따라오게 하는 방법 문의 드립니다. 첨부파일 (2)
새하늘 | 2021.06.17 | 추천 0 | 조회 39
새하늘 2021.06.17 0 39
3221 함수/공식
New 같은 품번별로 누적합계 구하기 (품번이 바뀔 경우 해당 행에서부터 다시 누적합계) 첨부파일 (2)
ploki | 2021.06.17 | 추천 0 | 조회 29
ploki 2021.06.17 0 29
3220 파워쿼리/피벗
New 파워피벗(DAX)에서 countif (중복 개수) 값을 얻고싶어요
ㅎㅎ | 2021.06.17 | 추천 0 | 조회 26
ㅎㅎ 2021.06.17 0 26
3219 파워쿼리/피벗
New 관계형 데이터베이스 구축관련 문의입니다 (1)
뀨1 | 2021.06.17 | 추천 1 | 조회 32
뀨1 2021.06.17 1 32
3218 VBA
New 도움을 요청합니다. 첨부파일 (5)
백설공주 | 2021.06.16 | 추천 0 | 조회 56
백설공주 2021.06.16 0 56
3217 기능/도구
New 확장형(?) 드롭다운 첨부파일 (3) 답변완료
치즈쿠키 | 2021.06.16 | 추천 0 | 조회 43
치즈쿠키 2021.06.16 0 43
3216 VBA
New vba 차트 그래프의 마지막 포인트의 위치값? 확인 방법 (2) 답변완료
aaaadcba | 2021.06.16 | 추천 0 | 조회 26
aaaadcba 2021.06.16 0 26
3215 VBA
New 피벗 갱신관련 VBA 구문 (2) 답변완료
H.B | 2021.06.16 | 추천 0 | 조회 35
H.B 2021.06.16 0 35
3214 함수/공식
New 특정 셀 값이 갖고 있는 목록 중 원하는 값을 순차적으로 가져오기 (3)
만수르용 | 2021.06.16 | 추천 0 | 조회 43
만수르용 2021.06.16 0 43
3213 VBA
New 함수(수식)의 값들을 값으로 변환 첨부파일
소금인형 | 2021.06.16 | 추천 0 | 조회 32
소금인형 2021.06.16 0 32
3212 VBA
New 배송 정보를 입력할때 데이터를 효율적으로 관리하고 싶은데요. 첨부파일 (4)
silverf**** | 2021.06.16 | 추천 0 | 조회 39
silverf**** 2021.06.16 0 39
3211 VBA
New 공유폴더에 엑셀 파일을 DB 용으로 사용할 경우 불러들이고 수정, 삭제하는데 로딩시간이 원래 오래걸리나요? (2) 답변완료
log | 2021.06.16 | 추천 0 | 조회 24
log 2021.06.16 0 24
3210 함수/공식
New 복식부기 중 iferror 관련 질문입니다. 첨부파일 (2) 답변완료
Yoon | 2021.06.16 | 추천 0 | 조회 25
Yoon 2021.06.16 0 25
3209 VBA
New 두번째 질문 올립니다. 범위안에서 선택이되었는지 첨부파일
게임쇼핑 | 2021.06.16 | 추천 0 | 조회 20
게임쇼핑 2021.06.16 0 20
3208 함수/공식
New 클릭하면 원하는 셀로 이동하는 함수 or 매크로 (3)
LJH | 2021.06.16 | 추천 0 | 조회 49
LJH 2021.06.16 0 49
3207 문서서식
New 엑셀 실기시험 관련해서 사소한 질문 하나 드립니다. (4) 답변완료
행복지기 | 2021.06.16 | 추천 0 | 조회 40
행복지기 2021.06.16 0 40
3206 피벗테이블
New 다시 질문드립니다! 피벗테이블 부분합 2개 만들기!
모찌율 | 2021.06.16 | 추천 0 | 조회 26
모찌율 2021.06.16 0 26
3205 VBA
New 엑셀로 Word 파일 생성 (1)
fire6**** | 2021.06.16 | 추천 0 | 조회 31
fire6**** 2021.06.16 0 31
3204 함수/공식
New 동일 그룹 내 중복값 입력 못하게 할 수 있을까요? 첨부파일 (4)
지옥나비 | 2021.06.15 | 추천 1 | 조회 61
지옥나비 2021.06.15 1 61
3203 VBA
New VBA 에서 for 반복문 사용 관련 질문! (2)
팡이 | 2021.06.15 | 추천 0 | 조회 32
팡이 2021.06.15 0 32
3202 VBA
New VBA Access 첨부파일 다운로드 (1)
조형진 | 2021.06.15 | 추천 0 | 조회 36
조형진 2021.06.15 0 36
3201 함수/공식
New 엑셀 중복을 제거하고 조건에 맞는 데이터 갯수 세기 (1)
칭구 | 2021.06.15 | 추천 0 | 조회 49
칭구 2021.06.15 0 49
3200 VBA
New VBA 피벗갱신 구문
H.B | 2021.06.15 | 추천 0 | 조회 24
H.B 2021.06.15 0 24
3199 VBA
매크로 이용하여 사진 삽입 후 저장된 파일을 이동하면 사진이 깨집니다. 도와주세요 첨부파일 (2)
큰공쥬 작은공쥬~ ♥ | 2021.06.15 | 추천 0 | 조회 38
큰공쥬 작은공쥬~ ♥ 2021.06.15 0 38
3198 문서서식
셀병합이안되네요 첨부파일 (5) 답변완료
현정이 | 2021.06.15 | 추천 0 | 조회 41
현정이 2021.06.15 0 41
3197 VBA
엑셀 파일 raw 한개를 여러 파일로 나누어 자동 저장하는 방법? (1)
아라아라다 | 2021.06.15 | 추천 0 | 조회 39
아라아라다 2021.06.15 0 39
3196 VBA
Sheet5에 값을 입력하였고 아무 코드도 적용시키지 않았는데 왜 Sheet2의 같은 자리에 입력이 되고 Sheet5에는 입력이 안될까요? (2)
log | 2021.06.15 | 추천 0 | 조회 31
log 2021.06.15 0 31