매킨토시

6월 13 2016

엑셀(EXCEL) – 일정행마다 제목행 추출과 일정행 아래의 특정 열들을 순차적으로 반복 이동

엑셀에서 VBA를 사용하는 경우 단순 반복 작업을 자동화하는 경우들에 유용한
방법입니다. 단순하게 반복하는 것과 논리적으로 반복하는 경우의 예를 아래에
들어보겠습니다. 처음에는 매크로 기록 기능으로 사용하다 조금 더 공부하시면
논리적으로 반복을 규칙화 시킬 수 있다고 봅니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3747083
엑셀 메크로 좀 도와주셔요ㅠㅠ

질문의 내용을 보시면 매크로 기록으로 한 번의 반복 작업을 기록하고 이것을
반복적으로 실행하는 법을 질문하셨는데 댓글에 DSFord님께서 반복매크로를
만들어 올려주셨는데 이것을 논리적 반복으로 바꾸어 보겠습니다.

아래의 두 매크로를 한 번 데이터를 500개 정도로 돌려봤는데 속도가 논리적 반복은
1초 정도인데 댓글의 방법으로 하니 150여초 정도 걸렸습니다. 숫자가 몇 천개되면
무시못할 정도의 시간과 쓸데없는? 작업을 하게됩니다.

' 반복의 단순화 매크로
Sub another_method()
 Dim i As Integer
 For i = 4 To 555
 Range("A20").Select
 Selection.Cut
 Cells(1, i).Select
 ActiveSheet.Paste
 Range("C21").Select
 Range("C21:C38").Select
 Selection.Cut
 Cells(2, i).Select
 ActiveSheet.Paste
 Rows("20:38").Select
 Selection.Delete Shift:=xlUp
 Next i

End Sub


' 논리적 반복으로 인한 매크로
설명은 주석으로 다 달아놓았으니 잘 해석해서 사용하세요.

Option Explicit

Sub Unit_Row_To_Col_Move()

Dim i As Integer, j As Integer, k As Integer
 Dim Unit As Integer, row_cnt As Integer
 Dim data_cnt As Long
 
 i = 0 ' list순서
 j = 0 ' 행위치
 k = 0 ' 단위 조직 위치
 Unit = 19 ' 단위 컬럼당 데이터 갯수
 
' 빨리 재배치를 할 경우, 채워지는 애니메이션을 보고 싶은 경우 주석 처리
 Application.ScreenUpdating = False
 
 Sheets("Data").Select

' 처리할 영역의 행 숫자를 구함, 여러 방법이 있지만 이것으로 ...
 row_cnt = Application.CountA(Range("A1", Range("A65536").End(xlUp)))
 
' 핵심 코드, 돌머리 굴리느라 힘들었어요. 엉엉엉 ...

For i = 20 To row_cnt
 
 ' 단위표의 크기에 따라 몫을 구해서 표의 위치 결정
 k = i \ Unit - 1
 
 ' 단위표의 몫을 구해 한 단위표의 위치를 정함
 j = i - (Unit * (i \ Unit))
 
 ' 정해진 위치에 제목과 데이터 뿌려주는 루틴, 잘 해석해 보세요.
 Cells(1, k + 4) = Cells(Unit * (k + 1) + 1, 1)
 Cells(j + 1, k + 4) = Cells(i + 1, 3)
 
 Next i
 
' 분리된 데이터 영역을 삭제 처리
 Columns("A:C").EntireColumn.Delete
 
' 이 앞에 까지는 눈에 보이지 않음. 완료된 시트 업데이트해서 보기
 Application.ScreenUpdating = True
 
End Sub

' 반복의 단순화 매크로

Sub another_method()

Dim i As Integer

For i = 4 To 555

Range("A20").Select

Selection.Cut

Cells(1, i).Select

ActiveSheet.Paste

Range("C21").Select

Range("C21:C38").Select

Selection.Cut

Cells(2, i).Select

ActiveSheet.Paste

Rows("20:38").Select

Selection.Delete Shift:=xlUp

Next i

End Sub

' 논리적 반복으로 인한 매크로

설명은 주석으로 다 달아놓았으니 잘 해석해서 사용하세요.

Option Explicit

Sub Unit_Row_To_Col_Move()

Dim i As Integer, j As Integer, k As Integer

Dim Unit As Integer, row_cnt As Integer

Dim data_cnt As Long

i = 0 ' list순서

j = 0 ' 행위치

k = 0 ' 단위 조직 위치

Unit = 19 ' 단위 컬럼당 데이터 갯수

' 빨리 재배치를 할 경우, 채워지는 애니메이션을 보고 싶은 경우 주석 처리

Application.ScreenUpdating = False

Sheets("Data").Select

' 처리할 영역의 행 숫자를 구함, 여러 방법이 있지만 이것으로 ...

row_cnt = Application.CountA(Range("A1", Range("A65536").End(xlUp)))

' 핵심 코드, 돌머리 굴리느라 힘들었어요. 엉엉엉 ...

For i = 20 To row_cnt

' 단위표의 크기에 따라 몫을 구해서 표의 위치 결정

k = i \ Unit - 1

' 단위표의 몫을 구해 한 단위표의 위치를 정함

j = i - (Unit * (i \ Unit))

' 정해진 위치에 제목과 데이터 뿌려주는 루틴, 잘 해석해 보세요.

Cells(1, k + 4) = Cells(Unit * (k + 1) + 1, 1)

Cells(j + 1, k + 4) = Cells(i + 1, 3)

Next i

' 분리된 데이터 영역을 삭제 처리

Columns("A:C").EntireColumn.Delete

' 이 앞에 까지는 눈에 보이지 않음. 완료된 시트 업데이트해서 보기

Application.ScreenUpdating = True

End Sub

위의 제목행의 논리를 찾아내는 방법이 어려웠어요. ㅠㅠ
첨부된 그림의 그래프롤 보시면 이해하실 수 있을 것입니다.
지우고 난 열값의 초기화에 따른 제목행을 선정하는 1차함수 유도

y=19*x +1 , 계산을 해 보면 알겠지만 k=0 부터 시작하므로 +1을 함

Cells(1, k + 4) = Cells(Unit * (k + 1) + 1, 1)

위의 코드를 잘 이해하셨으면 대부분의 반복 작업을 처리할 Module하나를
얻었고 이 코드를 응용해서 많은 부분을 자동화 할 수 있을 것으로 보입니다.
그냥 20개 행을 바로 바로 이동하는 코드는 쉬운데 제목행과 데이터행을
단위 갯수로 다르게 분리하는 부분이 상당히 어려운 부분이었습니다.

파일 첨부 : 20160610-리스트 형식을 특정 행으로 분리하여 열에 붙여넣기

By vinipapa • 무른모 • 0 • Tags: 엑셀(EXCEL), 특정열 분리 추출, 특정행

6월 7 2016

엑셀(EXCEL) – 엑셀 시트의 모든 차트를 PPT 슬라이드에 하나씩 혹은 여러장씩 붙여넣기

이 팁의 시작은 아래의 질문을 해결하는 방법을 구걸로 아이디어를 찾는 것이었는데

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3738549
엑셀 그래프를 자동으로 파워포인트로 옮겨주는 VBA나 매크로

비슷한 시기에 비슷한 내요의 질문이 올라와서 이것을 해결하는데 시간이 많이 걸렸네요.
아직도 9개 이상의 차트를 옮기면 슬라이드 하나에 붙여넣기를 해서 해결을 못했습니다.
며칠을 고민해도 차트 오브젝트를 추가 슬라이드에 복사하는 아이디어가 안 떠오르네요.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3741003
그래프 a4용지 사이즈에 이쁘게 넣는 방법 없을까요?

그냥 슬라이드 하나에 차트 옮기는 것은 쉬운데 하나에 여러 차트를 보기좋게 정렬까지는
할 수 있는데 차트의 갯수가 한 슬라이드의 기본 차트보다 많아지면 문제가 생기네요.
능력자들을 믿습니다. 해결 방법을 댓글로 주세요. 여기까지도 요령껏 사용하면 괜찮아요.

Option Explicit

' 아래 루틴들은 Microsoft PowerPoint xx.x Object Library.를 필요로 함
' xx.x 는 office version에 따라 참조되는 기준 (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010).

' 아래 루틴에서 참조되는 전역 변수 선언
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Dim cntCht As Integer

Private Sub ToPPTSlide()

 ' 워크 시트에 존재하는 모든 chart를 새 파워포인트 슬라이드로 옮김
 Dim sht As Worksheet
 Dim objCht As Object
 Dim j As Integer, Unit As Integer, i As Integer
 Dim row As Integer, col As Integer
 
 Dim chtTitle As String
 
 ' 속도를 위해 화면 갱신 중지
 Application.ScreenUpdating = False
 
 ' 워크북에 존재하는 chart의 갯수를 셈.
 For Each sht In ActiveWorkbook.Worksheets
 cntCht = cntCht + sht.ChartObjects.Count
 
 Next sht
 
 ' chart가 없을 경우 에러 메시지
 If cntCht + ActiveWorkbook.Charts.Count &lt; 1 Then
 MsgBox " 내보내기 할 차트가 없습니다!", vbCritical, "경 고"
 Exit Sub
 End If
 
 ' 열려있는 파워포인트가 있는지 체크
 On Error Resume Next
 Set pptApp = GetObject(, "PowerPoint.Application")
 On Error GoTo 0
 
 ' 파워포인트 실행하고 프리젠테이션 생성
 If pptApp Is Nothing Then Set pptApp = New PowerPoint.Application
 Set pptPres = pptApp.Presentations.Add
 
 ' 슬라이드 수를 세고 뒤에 하나 더 추가
 pptSlideCount = pptPres.Slides.Count
 Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
 
 ' 워크시트에 존재하는 모든 차트를 내보냄
 For Each sht In ActiveWorkbook.Worksheets
 For Each objCht In sht.ChartObjects
 
 Call ToPPT(objCht.Chart)

 Next objCht
 Next sht
 
 ' chart 시트에 별도로 만들어진 chart를 내보냄
 For Each objCht In ActiveWorkbook.Charts

 Call ToPPT(objCht)

 Next objCht
 
 ' 위의 경우 제목과 붙여진 차트의 형식 갖추기
 For j = 1 To pptSlide.Shapes.Count
 With pptSlide.Shapes(j)
 ' 그림이 붙여질 위치
 If .Type = msoPicture Then
 ' 비례 유지를 취소
 .LockAspectRatio = 0
 
 .Top = 86
 .Left = 34
 .Height = 410
 .Width = 650
 End If
 
 ' 제목 박스의 내용과 글꼴 변경
 If .Type = msoTextBox Then
 With .TextFrame.TextRange
 .Font.Color = vbBlue
 .Font.Name = "맑은 고딕"
 .Font.Size = 28
 .Font.Bold = msoTrue
 .ParagraphFormat.Alignment = ppAlignCenter
 .Text = chtTitle
 End With
 End If
 End With
 Next j

End Sub

Private Sub ToPPT(xlCht As Chart)
 
 On Error Resume Next
 
 xlCht.ChartArea.Copy
 
 ' 필요에 따라 ppPasetJPG를 여러 포멧으로 변경하여 내보냄
 pptSlide.Shapes.PasteSpecial ppPasteJPG
 
End Sub


Sub ChartsToPPT_By_9()

 ' 워크 시트에 존재하는 모든 chart를 새 파워포인트 슬라이드로 옮김
 Dim sht As Worksheet
 Dim objCht As Object
 Dim j As Integer, Unit As Integer, i As Integer
 Dim row As Integer, col As Integer
 
 ' 1열로 배치할 chart의 수
 Unit = 3
 
 ' 속도를 위해 화면 갱신 중지
 Application.ScreenUpdating = False
 
 ' 워크북에 존재하는 chart의 갯수를 셈.
 For Each sht In ActiveWorkbook.Worksheets
 cntCht = cntCht + sht.ChartObjects.Count
 
 Next sht
 
 ' chart가 없을 경우 에러 메시지
 If cntCht + ActiveWorkbook.Charts.Count &lt; 1 Then
 MsgBox " 내보내기 할 차트가 없습니다!", vbCritical, "경 고"
 Exit Sub
 End If
 
 ' 열려있는 파워포인트가 있는지 체크
 On Error Resume Next
 Set pptApp = GetObject(, "PowerPoint.Application")
 On Error GoTo 0
 
 ' 파워포인트 실행하고 프리젠테이션 생성
 If pptApp Is Nothing Then Set pptApp = New PowerPoint.Application
 Set pptPres = pptApp.Presentations.Add
 
 ' 슬라이드 수를 세고 뒤에 하나 더 추가
 pptSlideCount = pptPres.Slides.Count
 Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)

 
 ' 워크시트에 존재하는 모든 차트를 내보냄
 For Each sht In ActiveWorkbook.Worksheets
 For Each objCht In sht.ChartObjects
 
 Call ToPPT(objCht.Chart)

 Next objCht
 Next sht
 
 ' chart 시트에 별도로 만들어진 chart를 내보냄
 For Each objCht In ActiveWorkbook.Charts

 Call ToPPT(objCht)

 Next objCht
 
 ' 위의 경우 제목과 붙여진 차트의 형식 갖추기
 For j = 1 To pptSlide.Shapes.Count
 If j &gt; 9 Then
 pptSlide.MoveTo j \ 9
 End If
 
 With pptSlide.Shapes(j)
 ' 그림이 정렬될 위치 결정
 If .Type = msoPicture Then
 Select Case ((j - 1) \ Unit)
 Case 0
 row = 150
 col = (j Mod Unit) * 220
 
 Case 1
 row = 300
 col = (j Mod Unit) * 220
 
 Case 2
 row = 450
 col = (j Mod Unit) * 220
 
 End Select

 End If
 
 ' 원본과 비례 유지 False
 .LockAspectRatio = 0
 
 ' 그림 정렬될 위치
 .Top = row - 100
 .Left = col + 40
 .Height = 140
 .Width = 200
 
 End With
 
 Next j
 
 ' 속도를 위해 중지되었던 갱신 진행
 Application.ScreenUpdating = True
 
 ' 파워포인트 보이기
 pptApp.Visible = True

 ' chart개수 초기화
 cntCht = 0
 
 ' objects 지우기
 Set pptSlide = Nothing
 Set pptPres = Nothing
 Set pptApp = Nothing
 
End Sub

'엑셀 시트에 ActiveX 버튼하나 만드시고 아래 코드 연결시킵니다.
'1은 슬라이드 한장에 시트하나, 9는 9장의 시트를 정렬시킵니다.

Private Sub CommandButton1_Click()

 Dim kind As Integer
 
 kind = Application.InputBox("차트보내기 1: 1장씩, 9: 9장씩")

 If kind = 1 Then
 Call ChartsToPPT_By_1
 
 ElseIf kind = 9 Then
 Call ChartsToPPT_By_9
 
 End If

End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

Option Explicit

' 아래 루틴들은 Microsoft PowerPoint xx.x Object Library.를 필요로 함

' xx.x 는 office version에 따라 참조되는 기준 (11.0 = 2003, 12.0 = 2007 and 14.0 = 2010).

' 아래 루틴에서 참조되는 전역 변수 선언

Dim pptApp As PowerPoint.Application

Dim pptPres As PowerPoint.Presentation

Dim pptSlide As PowerPoint.Slide

Dim pptSlideCount As Integer

Dim cntCht As Integer

Private Sub ToPPTSlide()

' 워크 시트에 존재하는 모든 chart를 새 파워포인트 슬라이드로 옮김

Dim sht As Worksheet

Dim objCht As Object

Dim j As Integer, Unit As Integer, i As Integer

Dim row As Integer, col As Integer

Dim chtTitle As String

' 속도를 위해 화면 갱신 중지

Application.ScreenUpdating = False

' 워크북에 존재하는 chart의 갯수를 셈.

For Each sht In ActiveWorkbook.Worksheets

cntCht = cntCht + sht.ChartObjects.Count

Next sht

' chart가 없을 경우 에러 메시지

If cntCht + ActiveWorkbook.Charts.Count < 1 Then

MsgBox " 내보내기 할 차트가 없습니다!", vbCritical, "경 고"

Exit Sub

End If

' 열려있는 파워포인트가 있는지 체크

On Error Resume Next

Set pptApp = GetObject(, "PowerPoint.Application")

On Error GoTo 0

' 파워포인트 실행하고 프리젠테이션 생성

If pptApp Is Nothing Then Set pptApp = New PowerPoint.Application

Set pptPres = pptApp.Presentations.Add

' 슬라이드 수를 세고 뒤에 하나 더 추가

pptSlideCount = pptPres.Slides.Count

Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)

' 워크시트에 존재하는 모든 차트를 내보냄

For Each sht In ActiveWorkbook.Worksheets

For Each objCht In sht.ChartObjects

Call ToPPT(objCht.Chart)

Next objCht

Next sht

' chart 시트에 별도로 만들어진 chart를 내보냄

For Each objCht In ActiveWorkbook.Charts

Call ToPPT(objCht)

Next objCht

' 위의 경우 제목과 붙여진 차트의 형식 갖추기

For j = 1 To pptSlide.Shapes.Count

With pptSlide.Shapes(j)

' 그림이 붙여질 위치

If .Type = msoPicture Then

' 비례 유지를 취소

.LockAspectRatio = 0

.Top = 86

.Left = 34

.Height = 410

.Width = 650

End If

' 제목 박스의 내용과 글꼴 변경

If .Type = msoTextBox Then

With .TextFrame.TextRange

.Font.Color = vbBlue

.Font.Name = "맑은 고딕"

.Font.Size = 28

.Font.Bold = msoTrue

.ParagraphFormat.Alignment = ppAlignCenter

.Text = chtTitle

End With

End If

End With

Next j

End Sub

Private Sub ToPPT(xlCht As Chart)

On Error Resume Next

xlCht.ChartArea.Copy

' 필요에 따라 ppPasetJPG를 여러 포멧으로 변경하여 내보냄

pptSlide.Shapes.PasteSpecial ppPasteJPG

End Sub

Sub ChartsToPPT_By_9()

' 워크 시트에 존재하는 모든 chart를 새 파워포인트 슬라이드로 옮김

Dim sht As Worksheet

Dim objCht As Object

Dim j As Integer, Unit As Integer, i As Integer

Dim row As Integer, col As Integer

' 1열로 배치할 chart의 수

Unit = 3

' 속도를 위해 화면 갱신 중지

Application.ScreenUpdating = False

' 워크북에 존재하는 chart의 갯수를 셈.

For Each sht In ActiveWorkbook.Worksheets

cntCht = cntCht + sht.ChartObjects.Count

Next sht

' chart가 없을 경우 에러 메시지

If cntCht + ActiveWorkbook.Charts.Count < 1 Then

MsgBox " 내보내기 할 차트가 없습니다!", vbCritical, "경 고"

Exit Sub

End If

' 열려있는 파워포인트가 있는지 체크

On Error Resume Next

Set pptApp = GetObject(, "PowerPoint.Application")

On Error GoTo 0

' 파워포인트 실행하고 프리젠테이션 생성

If pptApp Is Nothing Then Set pptApp = New PowerPoint.Application

Set pptPres = pptApp.Presentations.Add

' 슬라이드 수를 세고 뒤에 하나 더 추가

pptSlideCount = pptPres.Slides.Count

Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)

' 워크시트에 존재하는 모든 차트를 내보냄

For Each sht In ActiveWorkbook.Worksheets

For Each objCht In sht.ChartObjects

Call ToPPT(objCht.Chart)

Next objCht

Next sht

' chart 시트에 별도로 만들어진 chart를 내보냄

For Each objCht In ActiveWorkbook.Charts

Call ToPPT(objCht)

Next objCht

' 위의 경우 제목과 붙여진 차트의 형식 갖추기

For j = 1 To pptSlide.Shapes.Count

If j > 9 Then

pptSlide.MoveTo j \ 9

End If

With pptSlide.Shapes(j)

' 그림이 정렬될 위치 결정

If .Type = msoPicture Then

Select Case ((j - 1) \ Unit)

Case 0

row = 150

col = (j Mod Unit) * 220

Case 1

row = 300

col = (j Mod Unit) * 220

Case 2

row = 450

col = (j Mod Unit) * 220

End Select

End If

' 원본과 비례 유지 False

.LockAspectRatio = 0

' 그림 정렬될 위치

.Top = row - 100

.Left = col + 40

.Height = 140

.Width = 200

End With

Next j

' 속도를 위해 중지되었던 갱신 진행

Application.ScreenUpdating = True

' 파워포인트 보이기

pptApp.Visible = True

' chart개수 초기화

cntCht = 0

' objects 지우기

Set pptSlide = Nothing

Set pptPres = Nothing

Set pptApp = Nothing

End Sub

'엑셀 시트에 ActiveX 버튼하나 만드시고 아래 코드 연결시킵니다.

'1은 슬라이드 한장에 시트하나, 9는 9장의 시트를 정렬시킵니다.

Private Sub CommandButton1_Click()

Dim kind As Integer

kind = Application.InputBox("차트보내기 1: 1장씩, 9: 9장씩")

If kind = 1 Then

Call ChartsToPPT_By_1

ElseIf kind = 9 Then

Call ChartsToPPT_By_9

End If

End Sub

첨부 화일 : 20160607-Chart-To-PPT_By_9Cht

End Sub

End Sub

꼭 해결 방법 올려주세요. 능력자님!!!

By vinipapa • 무른모 • 0

6월 2 2016

엑셀(EXCEL) – 불 특정한 스페이스로 분리된 셀을 스페이스 앞 뒤로 문자열 분리

업무를 진행하다 보면 참 애매한 경우가 많습니다. 갑님이 보내오신 메일의
양식을 바꾸어 달라고 할 수가 없어 을님들이 하지 않아도 될 일들을 해야할
경우인데요. 아래의 질문처럼 그냥 주문서를 엑셀로 받아서 처리하면 될 것
같은데 그냥 메일 내용속에 Text를 그냥 붙여서 오는 경우입니다.

http://www.clien.net/cs2/bbs/board.php?bo_table=kin&wr_id=3740799
——————————————————————————————
아웃룩메일로 들어온 데이터를 엑셀로 옮기고 싶은데요.

품번 수량
X4567890 20개
X4567891 20개
X4567892 20개
X4567893 30개
X4567894 20개

이런식으로 데이터가 들어오는데요.
——————————————————————————————

참 이런 것을 몇 백개씩 하루에 지속적으로 하고 계시는 것 같습니다.
시작합니다.

개발도구 > VBA Editor 열고 Module하나 삽입하시고 아래 코드를
붙여 넣습니다. 그리고 ActiveX 명령 버튼 하나 삽입하시고 매크로를
연결 시킵니다. 물론 제 블로그에 원본 자료 올려 놓으니 오셔서
내려 받고 그냥 사용하시면 됩니다.

Option Explicit

Sub Split_Text_To_Cell()
 
 ' 분리할 앞뒤 문자열과 영역 정의
 Dim fStr As String, rStr As String
 Dim rng As Range, rngRef As Range
 
 ' 분리할 영역 정의, 자동과 수동
 Set rngRef = Range("A1", Range("A65536").End(xlUp))
 
 ' 직접 영역을 선택할 경우
 'Set rngRef = Application.InputBox("분리 영역 선택", Type:=8)
 
 ' 선택된 영역을 순환하면서 분리함
 For Each rng In rngRef
 ' 일반적으로 분리하는 방법
 'fStr = Left(rng.Value2, InStr(rng.Value2, " ") - 1)
 'bStr = Right(rng.Value2, Len(rng.Value2) - InStrRev(rng.Value2, " "))
 
 ' 조금 있어 보이게 분리하는 방법 ^^;;;
 fStr = Mid(rng.Value2, 1, InStr(rng.Value2, " ") - 1)
 rStr = Mid(rng.Value2, InStrRev(rng.Value2, " ") + 1)
 
 ' 분리된 문자열을 셀에 입력함
 rng.Offset(0, 1).Value2 = fStr
 rng.Offset(0, 2).Value2 = rStr
 
 Next rng

End Sub

ps&gt; 더 편한 방법?


Sub Split_Text_by_도장님()
 
 ' 아래 방법 중 아무거나로 선택해서 진행
 ' 선택하는 방법도 여러가지가 있으니...
 ' 아래로 열들이 연속된 경우 사용
 'Range("A1", Range("A1").End(xldown)).Select
 ' 연속되지 않고 중간 열들이 비어 있는 경우
 'Range("A1", Range("A65536").End(xlUp)).Select

 Columns("A:A").Select
 
 Selection.TextToColumns

End Sub

Option Explicit

Sub Split_Text_To_Cell()

' 분리할 앞뒤 문자열과 영역 정의

Dim fStr As String, rStr As String

Dim rng As Range, rngRef As Range

' 분리할 영역 정의, 자동과 수동

Set rngRef = Range("A1", Range("A65536").End(xlUp))

' 직접 영역을 선택할 경우

'Set rngRef = Application.InputBox("분리 영역 선택", Type:=8)

' 선택된 영역을 순환하면서 분리함

For Each rng In rngRef

' 일반적으로 분리하는 방법

'fStr = Left(rng.Value2, InStr(rng.Value2, " ") - 1)

'bStr = Right(rng.Value2, Len(rng.Value2) - InStrRev(rng.Value2, " "))

' 조금 있어 보이게 분리하는 방법 ^^;;;

fStr = Mid(rng.Value2, 1, InStr(rng.Value2, " ") - 1)

rStr = Mid(rng.Value2, InStrRev(rng.Value2, " ") + 1)

' 분리된 문자열을 셀에 입력함

rng.Offset(0, 1).Value2 = fStr

rng.Offset(0, 2).Value2 = rStr

Next rng

End Sub

ps> 더 편한 방법?

Sub Split_Text_by_도장님()

' 아래 방법 중 아무거나로 선택해서 진행

' 선택하는 방법도 여러가지가 있으니...

' 아래로 열들이 연속된 경우 사용

'Range("A1", Range("A1").End(xldown)).Select

' 연속되지 않고 중간 열들이 비어 있는 경우

'Range("A1", Range("A65536").End(xlUp)).Select

Columns("A:A").Select

Selection.TextToColumns

End Sub

첨부 화일 : 불 특정한 스페이스로 분리된 셀을 스페이스 앞 뒤로 문자열 분리-20160602

By vinipapa • 무른모 • 0 • Tags: 문자열 분리, 스페이스, 엑셀

«< 2 3 4 5 6 >»

매킨토시

엑셀(EXCEL) – 일정행마다 제목행 추출과 일정행 아래의 특정 열들을 순차적으로 반복 이동

엑셀(EXCEL) – 엑셀 시트의 모든 차트를 PPT 슬라이드에 하나씩 혹은 여러장씩 붙여넣기

엑셀(EXCEL) – 불 특정한 스페이스로 분리된 셀을 스페이스 앞 뒤로 문자열 분리

카테고리

그 밖의 기능

매킨토시

엑셀(EXCEL) – 일정행마다 제목행 추출과 일정행 아래의 특정 열들을 순차적으로 반복 이동

엑셀(EXCEL) – 엑셀 시트의 모든 차트를 PPT 슬라이드에 하나씩 혹은 여러장씩 붙여넣기

엑셀(EXCEL) – 불 특정한 스페이스로 분리된 셀을 스페이스 앞 뒤로 문자열 분리

카테고리

그 밖의 기능

태그