[땡큐엑셀vba & 엑셀매크로] 셀사이 사이에 빈칸넣기
' http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=280817966
'
'가로로 한줄로 나열되어 있는 셀들이 엄청엄청 많이 있는데요 근데 이 셀들이 다 붙어 있어요!
'셀 4개씩 한묶음으로 하고 그 묶음 사이에 빈칸이 4칸이 오도록 하고 싶은데 어떻게 하면 좋을까요??
'일일이 하는 방법보단 자동으로 하는 방법이 있다면 알려주세요 셀이 너무 많아요 ㅠㅠ
'
' 빈칸을 몇개로 할지 A1셀에 값을 넣으시고(예:4)
' 한행에서 범위를 설정한후 실행하세요
'
' source by 땡큐엑셀vba & 엑셀매크로
'
Sub 빈칸삽입()
Dim t As Range
'빈칸수
빈칸 = Range("A1")
'선택한 범위
Set Rng = Selection
'선택한 범위의 갯수
갯수 = Selection.Count
몫 = Int(갯수 / 빈칸)
'끝에서 부터 빈칸 삽입
For i = 몫 To 1 Step -1
Set t = Rng.Cells(1, i * 빈칸).Offset(0, 1).Resize(1, 빈칸)
t.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next i
MsgBox "완료 되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 범위를 이미지파일(png)로 저장하기 (0) | 2020.08.02 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 파일명에 해당하는 이미지 삽입하기 (0) | 2020.08.01 |
[땡큐엑셀vba & 엑셀매크로] 옆셀에 a,b,c 붙여 추가하기 (0) | 2020.07.30 |
[땡큐엑셀vba & 엑셀매크로] 폴더의 파일목록, 파일갯수 출력 사용자 정의 함수 (0) | 2020.07.29 |
[땡큐엑셀vba & 엑셀매크로] yyyy.mm.dd 포맷으로 바꾸는 사용자정의 함수 (0) | 2020.07.28 |
[땡큐엑셀vba & 엑셀매크로] 옆셀에 a,b,c 붙여 추가하기
'
'source by 땡큐엑셀vba & 엑셀매크로
'
'3개의 셀삽입하고 _a, _b, _c 붙이기
Sub 열3개삽입()
'선택된셀 오른쪽으로(xlToRight) 3개의 셀삽입(Insert)
Selection.Offset(0, 1).Resize(1, 3).EntireColumn.Insert Shift:=xlToRight
값 = Selection
'첫번째
Selection.Offset(0, 1) = 값 & "_a"
'두번째
Selection.Offset(0, 2) = 값 & "_b"
'세번제
Selection.Offset(0, 3) = 값 & "_c"
MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 파일명에 해당하는 이미지 삽입하기 (0) | 2020.08.01 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 셀사이 사이에 빈칸넣기 (0) | 2020.07.31 |
[땡큐엑셀vba & 엑셀매크로] 폴더의 파일목록, 파일갯수 출력 사용자 정의 함수 (0) | 2020.07.29 |
[땡큐엑셀vba & 엑셀매크로] yyyy.mm.dd 포맷으로 바꾸는 사용자정의 함수 (0) | 2020.07.28 |
[땡큐엑셀vba & 엑셀매크로] 최대값의 이름 나열하기-사용자정의함수 (0) | 2020.07.27 |
[땡큐엑셀vba & 엑셀매크로] 폴더의 파일목록, 파일갯수 출력 사용자 정의 함수
'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=278999625&page=1#answer1
'
'안녕하세요. 현재 폴더안에 특정 파일수를 파악해서 알려주는 VBA를 사용중인데 속도가 너무 느려서요.
'꼭 사용자 정의 함수 형태로 만들어야 합니다.
'다른 형태로 알려 주는것들은 저도 이것 저것 가지고 있는데 사용자 정의 함수 형태로 만들어야 합니다.
'도스에서 CMD 에서 DIR로 파일수 떨궈서 알아 내는것하고 너무 속도 차이가 나서 사용하는데 문제가 많습니다.
'폴더당 10개 이런 수준이면 금방 하는데
'대상이 보통 폴더당 1,000개~2,000개의 jpg 파일이 있고 100개 정도의 폴더를 검색합니다. (네트워크 드라이버로 NAS 스토리지 접속)
'고수님들의 답변 부탁 드립니다. (파일 첨부 합니다.)
'source by 땡큐엑셀vba & 엑셀매크로
'
'해당경로의 jpg파일갯수를 출력합니다.
Function TQjpg(strPath)
Dim cmd As String
Dim res
'윈도우를 구동하는 쉘 프로그램(cmd 명령창)
Dim goWSH: Set goWSH = CreateObject("WScript.Shell")
' cmd창에서 dir 경로\*.* | find "jpg" /c 한것과 같습니다. /c 옵션을 사용하면 숫자가 나옵니다.
cmd = "cmd.exe /c dir " & strPath & "\*.* | find ""jpg"" /c "
Dim aRet: Set aRet = goWSH.exec(cmd)
res = CLng(aRet.stdout.readall())
TQjpg = res
End Function
'
'source by 땡큐엑셀vba & 엑셀매크로
'
'해당경로의 jpg파일리스트를 출력합니다.
'
Function TQList(strPath)
Dim cmd As String
Dim res
'윈도우를 구동하는 쉘 프로그램(cmd 명령창)
Dim goWSH: Set goWSH = CreateObject("WScript.Shell")
'dir /w 는 파일명만 출력합니다.
cmd = "cmd.exe /c dir /w " & strPath & "\*.* | find ""jpg"" "
Dim aRet: Set aRet = goWSH.exec(cmd)
res = aRet.stdout.readall()
TQList = res
End Function
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 셀사이 사이에 빈칸넣기 (0) | 2020.07.31 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 옆셀에 a,b,c 붙여 추가하기 (0) | 2020.07.30 |
[땡큐엑셀vba & 엑셀매크로] yyyy.mm.dd 포맷으로 바꾸는 사용자정의 함수 (0) | 2020.07.28 |
[땡큐엑셀vba & 엑셀매크로] 최대값의 이름 나열하기-사용자정의함수 (0) | 2020.07.27 |
[땡큐엑셀vba & 엑셀매크로] 수만장의 사진을 엑셀에 넣기 (0) | 2020.07.26 |
[땡큐엑셀vba & 엑셀매크로] yyyy.mm.dd 포맷으로 바꾸는 사용자정의 함수
'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=283220237
'날짜가
'2017.05.06 ~ 2018.08.06
'2016.5.08 ~2017.08.2
'이렇게 날짜가 입력되어 있을때
'1. 날짜를 yyyy.mm.dd로 바꾸는방법 그러니까 5.08을 05.08로 표시되도록
'2. 물결 양 옆 공백 제거하는법
'부탁드립니다.
'module
'Source by 땡큐엑셀vba & 엑셀매크로
'
'공백제거
Function removeSpace(r1 As String) As String
변환후 = Replace(r1, " ", "")
removeSpace = 변환후
End Function
'Source by 땡큐엑셀vba & 엑셀매크로
'yyyymmdd형식으로 변환
Function yyyymmdd(r1 As String) As String
'물결(~)을 구분자로 나눈다
분리보관 = Split(r1, "~")
'물결을 기준으로 앞부분 날짜
앞부분 = Split(분리보관(0), ".")
'물경을 기준으로 뒷부분 날짜
뒷부분 = Split(분리보관(1), ".")
'앞부분 날짜에서 월과 일자가 두자리씩 구성되었는지 확인하여 아닐경우 앞에 0을 붙인다.
If Len(앞부분(1)) = 1 Then 앞부분(1) = "0" & 앞부분(1)
If Len(앞부분(2)) = 1 Then 앞부분(2) = "0" & 앞부분(2)
'뒷부분 날짜에서 월과 일자가 두자리씩 구성되었는지 확인하여 아닐경우 앞에 0을 붙인다.
If Len(뒷부분(1)) = 1 Then 뒷부분(1) = "0" & 뒷부분(1)
If Len(뒷부분(2)) = 1 Then 뒷부분(2) = "0" & 뒷부분(2)
'앞부분(0),뒷부분(0)에는 년도가 들어있음
변경후 = 앞부분(0) & "." & 앞부분(1) & "." & 앞부분(2) & "~" & 뒷부분(0) & "." & 뒷부분(1) & "." & 뒷부분(2)
yyyymmdd = 변경후
End Function
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 옆셀에 a,b,c 붙여 추가하기 (0) | 2020.07.30 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 폴더의 파일목록, 파일갯수 출력 사용자 정의 함수 (0) | 2020.07.29 |
[땡큐엑셀vba & 엑셀매크로] 최대값의 이름 나열하기-사용자정의함수 (0) | 2020.07.27 |
[땡큐엑셀vba & 엑셀매크로] 수만장의 사진을 엑셀에 넣기 (0) | 2020.07.26 |
[땡큐엑셀vba & 엑셀매크로] 3개의 구간을 만족하는 값찾기 (0) | 2020.07.25 |
[땡큐엑셀vba & 엑셀매크로] 최대값의 이름 나열하기-사용자정의함수
'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=280221604
'
'다음 표에서 최대값만큼 가지고 있는 이름을 모두 추출해서 한 칸에 넣으려고 합니다.
'그러니까 한 칸에 최댓값인 3을 가지고 있는 나,라,바 가 적히도록 하는 방법을 찾고있습니다.
'최대값에 해당하는 이름을 출력하는 사용자정의함수
'이름이 1행에 있다는 가정에서 실행하세요.
'사용방법 : =MaxName(범위)
'예[I2]셀 =MaxName(B2:H2)
'
'
'
'source by 땡큐엑셀vba & 엑셀매크로
'
Function MaxName(rng As Range) As String
'해당범위에서 최대값을 구한다
최대값 = Application.WorksheetFunction.Max(rng)
'해당범위를 돌면서 최대값과 일치하는 셀이 있다면 이름을 계속 추가한다.
For Each r In rng
If r = 최대값 Then
최대값이름 = 최대값이름 & " " & Cells(1, r.Column)
End If
Next
MaxName = 최대값이름
End Function
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 폴더의 파일목록, 파일갯수 출력 사용자 정의 함수 (0) | 2020.07.29 |
---|---|
[땡큐엑셀vba & 엑셀매크로] yyyy.mm.dd 포맷으로 바꾸는 사용자정의 함수 (0) | 2020.07.28 |
[땡큐엑셀vba & 엑셀매크로] 수만장의 사진을 엑셀에 넣기 (0) | 2020.07.26 |
[땡큐엑셀vba & 엑셀매크로] 3개의 구간을 만족하는 값찾기 (0) | 2020.07.25 |
[땡큐엑셀vba & 엑셀매크로] 셀의 변경에 따른 카운트 증가 (0) | 2020.07.24 |
[땡큐엑셀vba & 엑셀매크로] 수만장의 사진을 엑셀에 넣기
'https://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=302833695
'이번에 엑셀 정리하면서
'사진만 수만장을 넣어야 하는데요..
'ex)
'셀 이름: ABC -456
'폴더 내 사진 파일 이름 : ABC-456
'이런식이면
'사진 크기가 셀에 맞게 자동으로 파일명을 찾아서 한번에
'수만장 삽입 되게 할 수 없을까요?
'하나씩 넣으니 너무 오래걸려서요~
'
'Source by 땡큐엑셀vba & 엑셀매크로
'
Sub 땡큐엑셀main()
Dim StrFile As String
Application.ScreenUpdating = False
On Error Resume Next '도중 에러 무시
For Each ea In Range("A:A")
If ea.Value = "" Then
Exit For
Else
'사진파일이 있는 경로를 아래와 같이 주면 됩니다.
'StrFile = "절대경로" & Target.Value & ".jpg"
StrFile = "c:\temp\" & ea.Value & ".jpg"
If Dir(StrFile) <> "" Then '파일유무 체크
ActiveSheet.Pictures.Insert(StrFile).Select '사진넣기
With Selection
.ShapeRange.LockAspectRatio = msoFalse '비율유지 해지
.Top = ea.Offset(0, 1).Top '셀크기에 맞도록 사진 사이즈 조정
.Left = ea.Offset(0, 1).Left '셀크기에 맞도록 사진 사이즈 조정
.Width = ea.Offset(0, 1).Width '셀크기에 맞도록 사진 사이즈 조정
.Height = ea.Offset(0, 1).Height '셀크기에 맞도록 사진 사이즈 조정
End With
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] yyyy.mm.dd 포맷으로 바꾸는 사용자정의 함수 (0) | 2020.07.28 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 최대값의 이름 나열하기-사용자정의함수 (0) | 2020.07.27 |
[땡큐엑셀vba & 엑셀매크로] 3개의 구간을 만족하는 값찾기 (0) | 2020.07.25 |
[땡큐엑셀vba & 엑셀매크로] 셀의 변경에 따른 카운트 증가 (0) | 2020.07.24 |
[땡큐엑셀vba & 엑셀매크로] 회원전체 pdf파일로 저장하기 (0) | 2020.07.23 |
[땡큐엑셀vba & 엑셀매크로] 3개의 구간을 만족하는 값찾기
'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=279914404
'
'표와 같이 3개의 구간 3번을 거쳐서 결과값을 찾는 작업인데요
'index/match로 하면 1개 구간은 검색이 되는데 3번 전부 매칭시켜서 답을 찾는게 안되네요 ㅠㅠ
'뭘 어떻게 해야 할까요??ㅠㅠ
'=INDEX(B2:E28,MATCH(B30&C30&D30,B2:B28&C2:C28&D2:D28,-1),4)
'이렇게 해도 안되더라구요
'저 구간들을 그냥 30, 19, 14로만 표기해서도 해봤는데 안되는데
'어떻게 해야 할까요??
'
'source by 땡큐엑셀vba & 엑셀매크로
'
Sub 값찾기()
조건1 = Cells(1, "B")
조건2 = Cells(1, "C")
조건3 = Cells(1, "D")
마지막행 = Cells(Rows.Count, "B").End(xlUp).Row
구분자 = "~"
'마지막행까지 루프돌며 3개의 구간을 만족하는 값 찾기
For i = 2 To 마지막행
'조건1
'split내장함수를 사용하여 두개의 값으로 나눈다. 두개의 값은 값1(0),갑1(1)에 들어간다.
값1 = Split(Cells(i, "B"), 구분자)
If 조건1 >= Int(값1(0)) And 조건1 <= Int(값1(1)) Then
'조건2
값2 = Split(Cells(i, "C"), 구분자)
If 조건2 >= Int(값2(0)) And 조건2 <= Int(값2(1)) Then
'조건3
값3 = Split(Cells(i, "D"), 구분자)
If 조건3 >= Int(값3(0)) And 조건3 <= Int(값3(1)) Then
'최종 일치하는 행 찾았다.
Cells(1, "E") = Cells(i, "E")
End If '조건3
End If '조건2
End If '조건1
Next i
MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 최대값의 이름 나열하기-사용자정의함수 (0) | 2020.07.27 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 수만장의 사진을 엑셀에 넣기 (0) | 2020.07.26 |
[땡큐엑셀vba & 엑셀매크로] 셀의 변경에 따른 카운트 증가 (0) | 2020.07.24 |
[땡큐엑셀vba & 엑셀매크로] 회원전체 pdf파일로 저장하기 (0) | 2020.07.23 |
[땡큐엑셀vba & 엑셀매크로] 단어찾아서 컬러문자 추가 (0) | 2020.07.22 |
[땡큐엑셀vba & 엑셀매크로] 셀의 변경에 따른 카운트 증가
'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=284157540
'sheet1에 a1 이라는 셀에는
'sheet2의 a1 값이 참조되어 있습니다
'sheet2에 a1 값이 오면 sheet1의 a1에 같은 값이 뜨면서 sheet1의 b1에는 숫자 1이 카운트 되고
'그 후 sheet2의 a1에 값이 지워지면 sheet1의 a1에도 값이 지워지겠지만 b1에는 1이 입력되어 있다가
'sheet2의 a1에 새롭게 숫자가 입력되면 sheet1의 b1에는 숫자2로 카운트 되는
'카운트가 누적되는 함수를 만들려면 어떻게 해야 할까요
'
' Source by 땡큐엑셀vba & 엑셀매크로
'
' calculate이벤트는 워크 시트를 다시 계산 한 후에 발생합니다.이때 특정된 셀을 분석하면 됩니다.
Private Sub Worksheet_Calculate()
'A1셀이 0,널이 아닌경우 B1셀에 1씩 증가
If Range("A1") = 0 Or Range("A1") = "" Then
Else
Range("B1") = Range("B1") + 1
End If
End Sub
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 수만장의 사진을 엑셀에 넣기 (0) | 2020.07.26 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 3개의 구간을 만족하는 값찾기 (0) | 2020.07.25 |
[땡큐엑셀vba & 엑셀매크로] 회원전체 pdf파일로 저장하기 (0) | 2020.07.23 |
[땡큐엑셀vba & 엑셀매크로] 단어찾아서 컬러문자 추가 (0) | 2020.07.22 |
[땡큐엑셀vba & 엑셀매크로] 색상을 수치와 글자로 표현하기 (0) | 2020.07.21 |
[땡큐엑셀vba & 엑셀매크로] 회원전체 pdf파일로 저장하기
'http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=279378268&page=1#answer1
'엑셀매크로 입니다.
'"회원" 워크시트에 있는 회원코드별로 매칭되는 데이터를 끌어와서
'반복인쇄하는것은 성공하였습니다.!!!
'여기서 Range("b7:g13").Select 반복인쇄 대신,
'전체 PDF 파일로 변환하는 매크로를 원합니다. (샘플첨부파일)
'(회원 지역별로 서울, 부산, 대구 등등 으로 분할 저장할수 있으면 더욱 좋습니다.)
'엑신님들의 답변 부탁드립니다. ^^/
'사전에 출력될 범위를 인쇄영역으로 설정하세요.
'
'source by 땡큐엑셀vba & 엑셀매크로
'
Sub 회원전체pdf로저장()
Set sht = ActiveSheet
Set shta = Sheets("회원")
'경고창 무시하기
Application.DisplayAlerts = False
'루프
For i = 3 To 16
'출력시트 A3셀에 회원코드를 넣어주면 나머지에는 수식이 걸려있어서 자동으로 변경됨
sht.Range("A3") = shta.Range("A" & i)
Call saveAsPdf(Range("A3"))
'Selection.PrintOut Copies:=1, Collate:=True
Next i
'경고창 활성화
Application.DisplayAlerts = True
MsgBox "완료되었습니다", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub
Sub saveAsPdf(strOpt1 As String)
'경로는 변경하여 사용하세요
경로 = "C:\temp\"
'회원코드가 파일명이 됩니다.
파일명 = strOpt1
'그리고 확장자 pdf를 붙인다.
전체경로 = 경로 & 파일명 & ".pdf"
'pdf로 변환하여 해당경로에 저장한다.
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=전체경로, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False
End Sub
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 3개의 구간을 만족하는 값찾기 (0) | 2020.07.25 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 셀의 변경에 따른 카운트 증가 (0) | 2020.07.24 |
[땡큐엑셀vba & 엑셀매크로] 단어찾아서 컬러문자 추가 (0) | 2020.07.22 |
[땡큐엑셀vba & 엑셀매크로] 색상을 수치와 글자로 표현하기 (0) | 2020.07.21 |
[땡큐엑셀vba & 엑셀매크로] 해당 날짜의 셀위치로 도형이동 (1) | 2020.07.20 |
[땡큐엑셀vba & 엑셀매크로] 단어찾아서 컬러문자 추가
' http://kin.naver.com/qna/detail.nhn?d1id=1&dirId=102020101&docId=287032869
'
' 토끼 셀마다 빨간색 "산"을 추가해야하는 비슷한 노가다를 하고 있는데.. 어떻게 하면 빠르게 할 수 있을까요? ㅠㅠ
'
' Source by 땡큐엑셀vba & 엑셀매크로
'
Sub 컬러문자추가()
Set 검색범위 = Selection
찾을값 = Cells(1, "D")
추가문구 = Cells(1, "E")
변경값 = 추가문구 & 찾을값
'범위 루프
For Each R In 검색범위
'글자 위치
pos = InStr(1, R.Value, 찾을값)
'길이
iLen = Len(R.Value)
'찾을값이 포함되어 있다면 변경값으로 교체함
If pos > 0 Then
temp = Replace(R.Value, 찾을값, 변경값) 'repalce함수를 사용
R.Value = temp
'글자 위치(예:산토끼)
pos = InStr(1, R.Value, 변경값)
'글자색 변경
With R.Characters(Start:=pos, Length:=1).Font
'.Name = "맑은 고딕"
'.FontStyle = "보통"
'.Size = 11
'.Strikethrough = False
'.Superscript = False
'.Subscript = False
'.OutlineFont = False
'.Shadow = False
'.Underline = xlUnderlineStyleNone
.Color = -16776961
'.TintAndShade = 0
'.ThemeFont = xlThemeFontMinor
End With
End If
Next
MsgBox "완료되었습니다.", vbInformation, "땡큐엑셀vba & 엑셀매크로"
End Sub
'엑셀vba예제' 카테고리의 다른 글
[땡큐엑셀vba & 엑셀매크로] 셀의 변경에 따른 카운트 증가 (0) | 2020.07.24 |
---|---|
[땡큐엑셀vba & 엑셀매크로] 회원전체 pdf파일로 저장하기 (0) | 2020.07.23 |
[땡큐엑셀vba & 엑셀매크로] 색상을 수치와 글자로 표현하기 (0) | 2020.07.21 |
[땡큐엑셀vba & 엑셀매크로] 해당 날짜의 셀위치로 도형이동 (1) | 2020.07.20 |
[땡큐엑셀vba & 엑셀매크로] 불량번호 삭제하기 (0) | 2020.07.19 |