Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Intersect(Target, Range("B4:B11")) Is Nothing Then Exit Sub With Target.Resize(1, Range("A1").Value).Interior If .ColorIndex = 6 Then .ColorIndex = 0 Else .ColorIndex = 6 End If End With End Sub

정말 쉽게 가르쳐 주시는데, 왜 구독자가 적지. 아무튼, 정말 감사합니다

Sub gugudan() Dim i As Long For i = 1 To 9 For j = 1 To 9 Cells(i, j) = i * j Next Next End Sub

Sub test2() If MsgBox("RPG 게임 좋아하시나요?", vbYesNo) = vbYes Then MsgBox "저도 좋아합니다" Else If MsgBox("그럼 액션 게임을 좋아하시나요?", vbYesNo) = vbYes Then MsgBox "액션 너무 좋죠" Else If MsgBox("심즈같은 시뮬레이션 게임을 좋아하시보네요!", vbYesNo) = vbYes Then MsgBox "드디어 맞췄네요!" Else MsgBox "이제 그만할게요. 안녕히계세요." End If End If End If End Sub

낯선 강의를 흥미있게 하시네요

안녕하세요... 그런데... 예를들어 데이터 하나 선택 완료후 i열 5행 시트에 기록이 되고, 그리고나서 다시 데이터 하나를 선택 완료하면 i열 6행에 데이터가 들어가야되는데..... 처음 i열 5행에 입력된 데이터는 지워지고.. 그 자리에 데이터가 들어가는데... 해결방법이 없을까요?...

안녕하세요. 여기서 진짜 필요한부분이 데이터 입력, 조회 그다음에 조회된 내용을 입력하기 버튼 누르면 자동으로 시트에 내용이 입력되게 하는 방법이 진짜 필요한데.. vba 교재까지 구매해서 몇번을 시도해봤는데.. 워낙 기초가 없다보니깐 조금만 상황이 달라져도.. 에러 나오고 방법을 모르겠습니다 ㅜㅜ .. 지금 만들고있는게 장비수리요청서 이런거 인데.. 어렵네요 ㅜㅜ

Sub CreateContinuousCalendar() Dim year As Integer Dim month As Integer Dim startRow As Integer Dim startCol As Integer Dim daysInMonth As Integer Dim firstDay As Integer Dim day As Integer ' 연도를 입력하세요 year = InputBox("달력을 생성할 연도를 입력하세요:", "연도 입력", 2023) startRow = 1 startCol = 1 ' 헤더 작성 Cells(startRow, startCol).Value = "연도: " & year startRow = startRow + 1 ' 각 달에 대해 반복 For month = 1 To 12 daysInMonth = Day(DateSerial(year, month + 1, 0)) ' 해당 월의 마지막 날 firstDay = Weekday(DateSerial(year, month, 1), vbSunday) ' 첫 날의 요일 ' 월 이름 작성 Cells(startRow, startCol).Value = MonthName(month) startRow = startRow + 1 ' 요일 헤더 Cells(startRow, startCol).Value = "일" Cells(startRow, startCol + 1).Value = "월" Cells(startRow, startCol + 2).Value = "화" Cells(startRow, startCol + 3).Value = "수" Cells(startRow, startCol + 4).Value = "목" Cells(startRow, startCol + 5).Value = "금" Cells(startRow, startCol + 6).Value = "토" startRow = startRow + 1 ' 빈 칸 추가 For i = 1 To firstDay - 1 Cells(startRow, startCol + i - 1).Value = "" Next i ' 날짜 채우기 For day = 1 To daysInMonth Cells(startRow, startCol + firstDay - 1 + day - 1).Value = day Next day ' 다음 달을 위해 행 업데이트 startRow = startRow + 2 ' 각 달 사이에 빈 행 추가 Next month ' 셀 크기 조정 Cells.Columns.AutoFit End Sub

안녕하세요. 반갑습니다. 구독좋아요

좋은 강의 감사합니다.. Sub test() Dim T Dim lastRow As Long Dim i As Long Dim V(3 To 50000) lastRow = Cells(Rows.Count, "G").End(xlUp).Row T = Now For i = 3 To lastRow V(i) = Cells(i, "G") * Cells(i, "H") Next Range("I3").Resize(lastRow - 2, 1) = Application.Transpose(V) T = Now - T MsgBox Format(T, "hh:mm:ss") End Sub

Sub gugudan() Dim i, j As Long For i = 1 To 9 For j = 1 To 9 Cells(i, j) = i * j Next Next End Sub

오늘도 좋은 강의 감사합니다 --------------------------------------------- Sub 매크로8() ' Dim endR As Long Dim lngA As Long Range("B4").CurrentRegion.Offset(1, 0).Interior.Color = xlNone endR = Cells(Rows.Count, "B").End(xlUp).Row For lngA = 5 To endR Step 1 If Range("C" & lngA).Value = Range("I5").Value And _ Range("E" & lngA).Value = Range("I7").Value And _ Range("I9").Value = "이상" And _ Range("F" & lngA).Value >= Range("J9").Value Then Range("B" & lngA).Resize(1, 5).Interior.ColorIndex = Range("I11").Interior.ColorIndex ElseIf Range("C" & lngA).Value = Range("I5").Value And _ Range("E" & lngA).Value = Range("I7").Value And _ Range("I9").Value = "이하" And _ Range("F" & lngA).Value <= Range("J9").Value Then Range("B" & lngA).Resize(1, 5).Interior.ColorIndex = Range("I11").Interior.ColorIndex End If Next lngA End Sub

오늘도 좋은 강의 감사합니다 !

이제 두강 남았네요

Sub 과제() Dim sh As Shape Dim str As String For Each sh In ActiveSheet.Shapes str = sh.Name If str <> "Button 1" And str <> "Drop Down 2" And str <> "Rectangle 3" Then sh.Delete End If Next sh End Sub

오늘도 좋은 강의 감사합니다 -------------------------------------------- Private Sub CommandButton1_Click() Dim lngA As Long Dim LB_1 As Control ''리스트박스1 Dim LB_2 As Control ''리스트박스2 Dim lngB As Long Application.ScreenUpdating = False Set LB_1 = Me.ListBox1 Set LB_2 = Me.ListBox2 lngA = LB_1.ListIndex ''위에서 0부터 시작함 If lngA = -1 Then Exit Sub With LB_2 lngB = ListBox2.ListCount .AddItem ListBox1.List(0, 0) ''리스트박스2에 빈방을 만드는 역할 .List(lngB, 0) = Format(LB_1.List(lngA, 0), "yyyy-mm-dd") .List(lngB, 1) = LB_1.List(lngA, 1) .List(lngB, 2) = LB_1.List(lngA, 2) .List(lngB, 3) = LB_1.List(lngA, 3) .List(lngB, 4) = Format(LB_1.List(lngA, 4), "#,##0") End With End Sub Private Sub CommandButton2_Click() Me.ListBox2.Clear End Sub Private Sub CommandButton3_Click() Unload Me End Sub Private Sub UserForm_Initialize() Dim lngA As Long Dim rngA As Range lngA = Cells(Rows.Count, "F").End(xlUp).Row Set rngA = Range("B5:F" & lngA) Me.ListBox1.RowSource = rngA.Address Me.ListBox1.ColumnCount = 5 Me.ListBox1.TextAlign = fmTextAlignCenter Me.ListBox1.MultiSelect = fmMultiSelectExtended Me.ListBox1.ColumnHeads = True Me.ListBox1.Width = 500 Me.ListBox1.ColumnWidths = "4cm; 2cm; 4cm; 2cm" End Sub

처음 접하는데, 매우 간단하게 설명해주셔서 이해가 잘 되었읍니다.

'행과 열을 비교하여 70점 이하인 점수만 빨간색으로 나타내라 Sub exe() Dim i As Long Dim j As Long Dim lngA As Long Dim lngC As Long lngA = Range("b100000").End(xlUp).Row lngC = Range("iv14").End(xlToLeft).Column For i = 2 To lngA For j = 2 To lngC If Cells(i, j) <= 70 Then Cells(i, j).Font.ColorIndex = 3 End If Next Next End Sub

음성은 에러가 발생하네요.. 메세지 지원하지 않는다는 에러가 뜨네요.. 음 ㅠㅠ.. 음성 멘트 셀을 다르게 해놨네요.. 지정셀이 다르면 그셀에 맞도록 셀을 지정해야하는데..깜박했었네요.. 본인 써놓은 셀을 지정해 줘야 하는데.. 어렵다요.. 철자하나 콤마하나 틀리면 에러라 .. 똑같이 했는데도 Sub 나 펑션이 지정이 안됐다고해서 별짓을 해봐도 안되어 Calculate 지운니 되긴한데 정상전체적으로 작동은 한하고 .너무 위아래 간격을 뛰워서그런건지..무지 까다로운 규직을 가진 여석이네요..다시 써서 입력하니 간격도 다시좁히고 하니 또 인식을 하는 현상이네요.. 뭔가 규칙이 잇어 보이는데..기본을 모르다보니.. 시행착오가 많이 발생을 하는군요..

오늘도 좋은 강의 감사합니다 !! Private Sub OptionButton1_Click() With Me.ListBox1 .rowsource = Range("리스트1").Address .columncount = 5 .TextAlign = fmTextAlignCenter .MultiSelect = fmMultiSelectExtended .ColumnHeads = True End With End Sub Private Sub OptionButton2_Click() With Me.ListBox1 .rowsource = Range("리스트2").Address .columncount = 5 .TextAlign = fmTextAlignCenter .MultiSelect = fmMultiSelectExtended .ColumnHeads = True End With End Sub

오늘도 좋은 강의 감사합니다!

열심히 정주행중입니다. 올려주셔서 감사합니다. Sub Test01() Dim i As Long Dim l As Long Dim lngC As Long Dim lngD As Long lngC = Range("B10000").End(xlUp).Row lngD = Range("iv2").End(xlToLeft).Column For i = 2 To lngC For l = 2 To lngD If Cells(i, l) <= 70 Then Cells(i, l).Font.ColorIndex = 3 End If Next Next End Sub

오늘도 좋은 강의 감사합니다 ^^ --------------------------------------------------- Private Sub CommandButton1_Click() Dim lngA As Long Dim lngB As Long Dim han As Long lngA = Len(TextBox1.Value) For lngB = 1 To lngA If Mid(TextBox1.Value, lngB, 1) Like "[ㄱ-흫]" Then han = han + 1 End If Next lngB If lngA = han Then MsgBox "입력 성공" Else MsgBox "한글만 입력해주세요" End If End Sub

얼굴합성하는 프로그램은 뭔가요?? 저도 써보고 싶어요. 저는 이제 vba강의 듣기 시작했습니다. 좋은 컨텐츠 감사해요

미루고 미루다 너무나 좋은 강의 만나 다시 시작합니다. 정말 감사합니다! :)

실력이 안되서 for문으로만 올려봅니다.. Sub test() Dim i As Long Dim j As Long Dim lngA As Long Dim lastRow As Long Range("C2:C17").AdvancedFilter xlFilterCopy, Range("C2"), Range("J2"), True lastRow = Range("J2").End(xlDown).Row For i = 3 To lastRow lngA = 0 For j = 3 To 17 If Range("J" & i) = Range("C" & j) Then lngA = lngA + 1 Range("J" & i).Offset(, lngA) = Range("D" & j) End If Next j Next i End Sub

엑셀 가계부 설정탭에서 설정한 값들이, 월별탭 분류에 적용되도록 만들고싶어서 찾아보다가 여기까지 흘러왔습니다. 좋은 강의자료 올려주셔서 감사합니다. 열심히 배워보겠습니다.

재미있습니다. Private Sub CommandButton1_Click() Range("A1") = Me.TextBox1 Me.ComboBox1 = Range("A3") Me.TextBox3 = Range("A4") End Sub Private Sub CommandButton2_Click() Dim rt As Integer rt = Range("A2") Range("D" & rt) = Me.TextBox1 Range("E" & rt) = Me.ComboBox1 Range("F" & rt) = Me.TextBox3 End Sub Private Sub CommandButton3_Click() Dim rt As Integer rt = Range("A2") Range("C" & rt).Resize(1, 4).Delete End Sub Private Sub UserForm_Initialize() Me.ComboBox1.List = Array("남", "여") End Sub

뽀로로 과제물 만드느라 수고하셨습니다. Sub test02() Dim rngd As Range Dim rngt As Range Set rngd = Range("rngimage") rngd.Interior.ColorIndex = 0 For Each rngt In rngd If rngt = 1 Then rngt.Interior.ColorIndex = 50 End If Next rngt End Sub

안녕하세요 엑사남님 영상을 보다가 하나 여쭤보고 싶은 것이 있어 연락드립니다 서버에서 가져온 레코드셋이랑 로컬에 있는 레코드셋이랑 한번에 쿼리문을 작성할 방법이 있을까요…? 서버 연결하면 서버 내에 있는 레코드셋만 이용해서만 쿼리문을 작성할수 있더라구요..

좋은 강의 감사합니다.. Private Sub ob1_Click() Dim rngA As Range Set rngA = Range("B4", "F" & Range("B4").End(xlDown).Row) If ob1 Then lb.RowSource = rngA.Address lb.ColumnCount = 5 lb.ColumnHeads = True End If End Sub Private Sub ob2_Click() Dim rngA As Range Set rngA = Range("I4", "M" & Range("I4").End(xlDown).Row) If ob2 Then lb.RowSource = rngA.Address lb.ColumnCount = 5 lb.ColumnHeads = True End If End Sub

Sub test1() If MsgBox("당신은 김영준 입니까?", vbYesNo) = vbYes Then MsgBox "저는 김나은 입니다." Else MsgBox "나가시오!!" End If If MsgBox("김나은을 사랑합니까?", vbYesNo) = vbYes Then MsgBox "나동♡" Else MsgBox "나쁜새*죽을라고!!***" End If End Sub

단추 안누르고 엑셀 파일열때 바로 실행창 뜨게하는 방법은 없을까용?

Sub 또는 function이 정의 되지 않았다고 뜹니당ㅜ

감사합니다. Sub union_test3() Dim lnge As Long Dim rngd As Range Dim i As Long lnge = Range("f1000").End(xlUp).Row Range("o6").CurrentRegion.Offset(1, 0).Clear For i = 7 To lnge If Range("g" & i) = "여" Then If Range("L" & i) >= 70 Then If rngd Is Nothing Then Set rngd = Range("g" & i).Offset(0, -1).Resize(1, 7) Else Set rngd = Union(rngd, Range("g" & i).Offset(0, -1).Resize(1, 7)) End If End If End If Next If rngd Is Nothing Then MsgBox "복사할 범위가 없어요." Else rngd.Copy Range("o7") End If End Sub

🔘 너무나 쉽게 강의하여 감사합니다.

이번에는 조금 쉬워서 마음이 가볍네요. Sub sort_test4() Dim rngd As Range Set rngd = Range("L12:S" & Range("B2")) rngd.Sort key1:=Range("m12"), order1:=xlAscending, _ Key2:=Range("N12"), order2:=xlDescending, _ Key3:=Range("s12"), order3:=xlDescending, Header:=xlYes End Sub

잘동작되니 재미가 있네요. 쉽게 가르쳐 주셔서 좋네요. Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Target.Count > 1 Then If Target.Cells(1, 1) <> "" Then Call chart01 Cancel = True Else If Target.Cells(1, 1) = "" Then If ActiveSheet.ChartObjects.Count > 0 Then ActiveSheet.ChartObjects.Delete End If End If End If End If End Sub

Sub test() Dim i As Integer Dim 남 As String For i = 7 To Range("b2").Value If Range("F" & i) = "남" Then Range("e2:i2").Copy Range("e" & i).PasteSpecial xlPasteFormats Range("j2:k2").Copy Range("j" & i).PasteSpecial Else Range("e3:i3").Copy Range("e" & i).PasteSpecial xlPasteFormats Range("j3:k3").Copy Range("j" & i).PasteSpecial End If Next i Application.CutCopyMode = False End Sub

Sub 색지우기() Range("F7").CurrentRegion.Interior.ColorIndex = 0 End Sub

Sub Test_3() Dim i As Long Dim j As Long For i = 2 To 11 For j = 3 To 12 If Cells(i, j) < 500 Then Cells(i, j).Font.Color = 14791492 End If Next Next End Sub

선생님 말씀대로 vba를 배우고 싶어도 어디서 부터 어떻게 시작해야할지 모르는 사람들에게 이 강의가 정말 많이 힘이 되고 있다는 말씀 꼭 드리고 싶습니다. 비록 올린지는 3년이 넘었지만 누군가는 이 강의를 소중하게 보고 또 보고 있다는 것을 말씀드리고 싶어서 강의 들어가기전 댓글 올립니다.

오늘도 감사합니다 ^^! ---------------------------------- Sub PDF_Save() Dim strPath As String Dim strFile As String Dim strSave As String strPath = "C:\Users\OOOOO\Desktop\" strFile = "테스트PDF_" & Format(Date, "YYMMDD") strSave = strPath & strFile & ".pdf" Sheet1.ExportAsFixedFormat _ Type:=xlTypePDF, _ Filename:=strSave, _ Quality:=xlQualityStandard, _ IncludeDocProperties:=True, _ IgnorePrintAreas:=True, _ From:=1, _ To:=1, _ OpenAfterPublish:=False ''다 저정하고 미리보기 할꺼니 ''ignore 같은 경우 전체 페이지를 인쇄 할 경우 True, 원하는 페이지만 인쇄할 경우 False ''밑에 From, To 는 몇 페이지부터 몇 페이지까지 인쇄인지 설정하는 것 Sheet1.DisplayPageBreaks = False ''구분선 삭제 End Sub

훌륭한강의감사합니다

엇,,, 최근에 다른곳에서도 시도하다가 계속 실패했는데, 엑사남님 파일 설치 받아서 완료 되고 실행해보니, 13 런타임 오류가 나네요... 해결 방법이 뭐가 있을까요? m365쓰고 있습니다.

항상 감사합니다 !! ------------------------------ Private Function Error_test() As String Dim strB As String strB = "" If Me.TextBox1 = "" Then strB = "성명 누락" Me.TextBox1.BackColor = vbRed Else Me.TextBox1.BackColor = 16777215 End If If Me.ComboBox1 = "" Then strB = strB & vbCr & "성별 누락" Me.ComboBox1.BackColor = vbRed Else Me.ComboBox1.BackColor = 16777215 End If If Me.TextBox2 = "" Then strB = strB & vbCr & "나이 누락" Me.TextBox2.BackColor = vbRed Else Me.TextBox2.BackColor = 16777215 End If If Not IsNumeric(Me.TextBox2) Then strB = strB & vbCr & "나이는 숫자만 가능" Me.TextBox2.BackColor = vbRed Else Me.TextBox2.BackColor = 16777215 End If Error_test = strB End Function

이런 고퀄강의를 유튜브에서 무료로 볼 수 있다니 정말 감사합니다 .

항상 감사합니다! 추천해주신 엑셀 함수를 함께 이용한 방법을 시도해 본 후, 순수 VBA로 진행을 해보았습니다 말씀해주신대로 엑셀 함수를 함께 활용하면 더 간편해져서 좋았습니다 ^^ ------------------------------------------------------------------------------------------------------------------- Private Sub CommandButton1_Click() Dim R As Long ''끝행 R = Cells(Rows.Count, "C").End(xlUp).Row + 1 If WorksheetFunction.CountIf(Range("D:D"), Me.TextBox1) > 0 Then MsgBox "중복값이 있습니다. 확인해주세요" Exit Sub End If Range("C" & R) = R - 2 Range("D" & R) = Me.TextBox1 Range("E" & R) = Me.ComboBox1 Range("F" & R) = Me.TextBox2 Range("C1:F1").Copy Range("C" & R).PasteSpecial xlPasteFormats Application.CutCopyMode = False Range("C2").Select End Sub Private Sub CommandButton2_Click() '' 조회 Dim lngR As Long '' 끝행 Dim lngA As Long '' 순환 lngR = Cells(Rows.Count, "C").End(xlUp).Row For lngA = 3 To lngR Step 1 If Range("D" & lngA) = Me.TextBox1 Then If WorksheetFunction.CountIf(Range("D:D"), Me.TextBox1) = 1 Then Me.ComboBox1 = Range("E" & lngA) Me.TextBox2 = Range("F" & lngA) ElseIf WorksheetFunction.CountIf(Range("D:D"), Me.TextBox1) <> 1 Then MsgBox "중복 데이터가 입력되었습니다" Exit Sub End If End If Next lngA End Sub Private Sub CommandButton3_Click() '' 수정 Dim lngR As Long '' 끝행 Dim lngA As Long '' 순환 lngR = Cells(Rows.Count, "C").End(xlUp).Row For lngA = 3 To lngR Step 1 If Range("D" & lngA) = Me.TextBox1 Then If WorksheetFunction.CountIf(Range("D:D"), Me.TextBox1) = 1 Then Range("E" & lngA) = Me.ComboBox1 Range("F" & lngA) = Me.TextBox2 ElseIf WorksheetFunction.CountIf(Range("D:D"), Me.TextBox1) <> 1 Then MsgBox "중복 데이터가 입력되었습니다" Exit Sub End If End If Next lngA End Sub Private Sub CommandButton4_Click() ''삭제 Dim lngR As Long '' 끝행 Dim lngA As Long '' 순환 lngR = Cells(Rows.Count, "C").End(xlUp).Row For lngA = 3 To lngR Step 1 If Range("D" & lngA) = Me.TextBox1 Then If WorksheetFunction.CountIf(Range("D:D"), Me.TextBox1) = 1 Then Range("D" & lngA).EntireRow.Delete ElseIf WorksheetFunction.CountIf(Range("D:D"), Me.TextBox1) <> 1 Then MsgBox "중복 데이터가 입력되었습니다" Exit Sub End If End If Next lngA End Sub Private Sub UserForm_Initialize() Me.ComboBox1.List = Array("남", "여") End Sub

이쪽으로 언어, 배열개념이 없었는데요. 한 3번 보고 로직 생각하면서 1개월정도 고민하니깐 조금 이해가되고 있네요.ㅎㅎ

항상 감사합니다 ^^ Sub total() ''인풋박스가 여러개일 경우 프로시저를 만들어서 ''각각 박스에 따로 걸어줘야 하는 경우 비효율적이니 ''한개의 프로시저에 여러 인풋박스 명령문을 넣고 ''각각 박스에 통합 프로시저를 지정하는 작업 Dim strA As String strA = Application.Caller '' caller 는 버튼의 이름 '' ex) 인풋박스의 이름 정의임 If strA = "버튼1" Then ''성명입력 버튼이라면 Dim strB As String strB = Application.InputBox("성명을 입력하세요", "성명", "성명") If strB = "False" Then MsgBox "입력한 성명이 업습니다" ''취소를 누른 경우 Else Range("C3") = strB End If ElseIf strA = "버튼2" Then Dim rngA As Range On Error Resume Next ''set rngA 했을 때, 취소를 누르면 set 자체가 안되기때문에 ''rngA is nothing 문구에서 판단 할 거리 자체가 없어버리는 에러 발생 ''set 이 되어야 맞는지 아닌지 선택하는데 set 자체가 없으니 다음 판단문에서 오류 발생 ''그래서 오류가 있어도 진행하게 만드는 것. Set rngA = Application.InputBox("성별을 입력하세요", "성별", "성별", , , , , 8) If rngA Is Nothing Then MsgBox "입력된 성별이 없습니다" Else Range("C5") = rngA End If ElseIf strA = "버튼3" Then Dim strC As String strC = Application.InputBox("나이를 입력하세요", "나이", "나이") If strC = "False" Then MsgBox "입력된 나이가 없습니다" Else Range("C7") = strC End If End If End Sub ---------------------------------------- Sub color_change() Dim rngA As Range ''선택한 셀 Dim rngB As Range ''색깔을 입힐 선택할 범위 On Error Resume Next Set rngA = Application.InputBox("색깔을 선택하세요", "색깔선택", "색깔", , , , , 8) If rngA Is Nothing Then MsgBox "선택된 색깔이 없습니다" Exit Sub ElseIf rngA.Count > 1 Then MsgBox "한개의 색깔만 선택하세요" Exit Sub End If Set rngB = Application.InputBox("범위를 선택하세요", "범위선택", "범위", , , , , 8) If rngB Is Nothing Then MsgBox "선택된 범위가 없습니다" Exit Sub Else rngB.Interior.Color = rngA.Interior.Color End If On Error GoTo 0 End Sub