find (8)
[VBA] Find - Dictionary,Collection대용
반응형

[엑셀 실무][range.find를 이용한](여러 업체가 있는 )업체명부에서 업체별로 (열 단위로)근무자 뽑아내기

 

위 자료를 아래 모양을 바꾸기

Sub get_com_man()

Dim rngX As Range
Dim shtX As Worksheet
Dim shtY As Worksheet

Set shtX = Worksheets("업체명부")
Set shtY = Worksheets("근무자")
Set rngX = shtX.Range("a1").CurrentRegion

Dim r As Long
Dim row As Range
Dim scode As String
Dim rngF As Range     'Find는 값을 찾으나 Range 의 형식을 갖는다

shtY.Range("a2:y10000").Clear

For r = 2 To rngX.Rows.Count
   Set row = rngX.Rows.Item(r)   'rngX의 행범위를 담는다.
   scode = row.Cells(1).Value   '왼 코드를 이 코드(scode = row.Cells(r, "a").Value)로 바꾸면
   '값이 이상해지고,디버그발생한다. 왜?
   Set rngF = shtY.Columns(1).Find(scode)  'Columns(1) = Columns("A:A")
   'shtY.Range("a2:y10000").Clear '본 코드를 이 자리에 있으면 모듈 에러남...?
      If rngF Is Nothing Then
         shtY.Range("a10000").End(xlUp).Offset(1).Resize(1, 3).Value = _
         Array(row.Cells(1).Value, row.Cells(2), row.Cells(4).Value)
      Else
         rngF.End(xlToRight).Offset(0, 1).Value = row.Cells(4).Value
      End If
Next r
End Sub


For r = 2 To rngX.Rows.Count
   Set row = rngX.Rows.Item(r)
   scode = row.Cells(1).Value
   Set rngF = shtY.Columns(1).Find(scode)

      If rngF Is Nothing Then
         shtY.Range("a10000").End(xlUp).Offset(1).Resize(1, 3).Value = _
         Array(row.Cells(1).Value, row.Cells(2), row.Cells(4).Value)
      Else
         rngF.End(xlToRight).Offset(0, 1).Value = row.Cells(4).Value
      End If


https://www.youtube.com/watch?v=pqFFI-SNs_g&list=PLxmyPu_Id2snuVKanUgX_buujbFPjiY-R&index=108

2023.12.15 - 엑셀 VBA #42 / Find메서드_기본 [VBA]

2024.01.11 - [VBA] Dictionary에 대한 이해1




반응형
  Comments,     Trackbacks
엑셀 VBA #85 / 이벤트 프로시저와 find 메서드 활용하기 [VBA]
반응형

엑셀 VBA #85 / 이벤트 프로시저와 find 메서드 활용하기 [VBA]

 


Private Sub Worksheet_Change(ByVal Target As Range)

      Dim rng As Range
      Dim fc As Range
      
      If Not Intersect(Target, Columns("b")) Is Nothing Then
            Set rng = Sheet2.Range("a2:a32")
            
            On Error Resume Next
                  Set fc = rng.Find(Day(Target.Offset(0, -1)), , , xlWhole)
            On Error GoTo 0
            
            If Not fc Is Nothing Then
                  fc.Offset(0, 1) = Target.Value
            Else
                  MsgBox "정확한 값을 입력하세요."
            End If            
      End If
End Sub

vba#85.xlsm
0.02MB

 

 

2023.12.13 - 엑셀 VBA #13 / 셀 범위 선택하기_8 [VBA] - Intersect

2023.12.13 - 엑셀 VBA #14 / 셀 범위 선택하기_9 [VBA] - Intersect 실무예제

2023.12.15 - 엑셀 VBA #42 / Find메서드_기본 [VBA]


https://www.youtube.com/watch?v=qAAJvBXT7zo&t=414s



 

반응형
  Comments,     Trackbacks
엑셀 VBA #65 / 질문 답변(데이터 취합) [VBA]
반응형

엑셀 VBA #65 / 질문 답변(데이터 취합) [VBA]

[하나의 통합문서에 있는 여러 시트들의 데이터들을
중복데이터 제거 후 '통합'시트에 하나로 취합하는 방법]

해결 방법
1. 엑셀 기능(RemoveDuplicates) 적용한 VBA코딩
2. New Collection활용 한 VBA코딩

 

1. 엑셀 기능(RemoveDuplicates) 적용한 VBA코딩

Sub 통합생성_고유항목만_1()

Dim shAll As Worksheet
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False  '기존 통합시트 삭제시 '삭제하시겠습니까?'라는 메세지창 나오기 않게!
On Error Resume Next   '만약 기존 통합시트가 없는 경우에, 아래 코드 실행시 에레 발생하므로

                                         본 코드삽입하여 에레발생하면 그냥 넘어가라는 의미
    Sheets("통합").Delete
On Error GoTo 0

Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "통합"
Set shAll = Sheets("통합")

For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ActiveSheet.Name Then '만약 시트 이름이 activesheet(현재활성화된 시트=통합)이름과 다르다면
        sh.Range("A1").CurrentRegion.Copy shAll.Cells(Rows.Count, "a").End(xlUp).Offset(1)
    End If
Next

shAll.Range("A2").CurrentRegion.RemoveDuplicates (Array(1, 2))

shAll.Rows(1).Delete


Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

2. New Collection활용 한 VBA코딩

Sub 통합생성_고유항목만_2()

Dim shAll As Worksheet
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.DisplayAlerts = False 
On Error Resume Next 
    Sheets("통합").Delete
On Error GoTo 0

Worksheets.Add(after:=Sheets(Sheets.Count)).Name = "통합"
Set shAll = Sheets("통합")

For Each sh In ThisWorkbook.Worksheets
    If sh.Name <> ActiveSheet.Name Then
        sh.Range("A1").CurrentRegion.Copy shAll.Cells(Rows.Count, "a").End(xlUp).Offset(1)
    End If
Next

'----------------------------------------
'New Collection
'----------------------------------------
Dim rng As Range, c As Range
Dim pc As New Collection
Dim e As Variant
Dim i

Set rng = shAll.Range("A2", shAll.Cells(Rows.Count, "A").End(xlUp))

On Error Resume Next
For Each c In rng
    If Len(c) Then
        pc.Add Trim(c), CStr(Trim(c))
    End If
Next
On Error GoTo 0

For Each e In pc
    i = i + 1
    shAll.Cells(i, "d") = e
    shAll.Cells(i, "e") = rng.Find(e, , , xlWhole).Offset(, 1).Value
Next
shAll.Columns("a:c").Delete

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

 

vba#65.xlsm
0.03MB



https://www.youtube.com/watch?v=Tp7qn6n_wVM&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=65

ㅁㅁㅁ

반응형
  Comments,     Trackbacks
엑셀 VBA #45 / Find메서드_변형3 [VBA] - 중복표시
반응형

엑셀 VBA #45 / Find메서드_변형3 [VBA]

Dim sh8 As Worksheet, sh7 As Worksheet
Dim rng As Range, cf As Range
Dim ad As String

Set sh8 = Sheets("2018")
Set sh7 = Sheets("2017")
Set rng = sh7.Range("B3", sh7.Cells(Rows.Count, "B").End(xlUp))

'Cells(Rows.Count,"B")만 쓰면 오류 발생가능성 있으므로, 시트명 sh7를 붙힐 것

For Each c In sh8.Range("B3", sh8.Cells(Rows.Count, "B").End(xlUp))
    Set cf = rng.Find(c, , , xlWhole)
    If Not cf Is Nothing Then
        ad = cf.Address
        Do
            c.Offset(, 2) = "○"
            Set ccf = rng.FindNext(cf)
        
        Loop Until cf.Address = ad
    End If

결과값
vba#45.xlsm
0.02MB


https://www.youtube.com/watch?v=hSXQKoyhXNE&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=45


반응형
  Comments,     Trackbacks
엑셀 VBA #44 / Find메서드_변형2 [VBA] - 역방향으로 찾기
반응형

엑셀 VBA #44 / Find메서드_변형2 [VBA] - 역방향으로 찾기



Dim rng As Range, cf As Range
Dim ad As String

Set rng = Range("B3", Cells(Rows.Count, "B").End(xlUp))
Set cf = rng.Find("서울", Range("B18"), , xlWhole, , xlPrevious)

If Not cf Is Nothing Then
    ad = cf.Address
    Do
        
        Cells(Rows.Count, "E").End(3)(2) = cf.Offset(, -1)
        Set cf = rng.FindPrevious(cf)
    
    Loop Until cf.Address = ad
    
End If

결과값
vba#44.xlsm
0.02MB



https://www.youtube.com/watch?v=beI2XhKg3Yg&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=44


반응형
  Comments,     Trackbacks
엑셀 VBA #43 / Find메서드_변형1 [VBA]
반응형

엑셀 VBA #43 / Find메서드_변형1 [VBA]


Dim rng As Range, cf As Range
Dim ad As String

Set rng = Range("A2", Cells(Rows.Count, "A").End(xlUp))
Set cf = rng.Find("A-1", , , xlWhole)

If Not cf Is Nothing Then          'cf값이 있으면
    ad = cf.Address                    'ad라는 변수에 cf값을 넣는다.
    Do
        cf.Interior.ColorIndex = 43
        Set cf = rng.FindNext(cf)       '기존 찾았던 cf셀 이후로 찾는다--findnext
    Loop Until cf.Address = ad        'cf의 주소가 처음 주소와 같을 때 까지 Do~Loop구문작동
End If


[실무에서 가장 많이 사용되는 Find문 구조]
If Not cf Is Nothing Then  
    ad = cf.Address        
    Do
        
    Loop Until cf.Address = ad  
End If

https://www.youtube.com/watch?v=rVCct3N5VOA&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=43

반응형
  Comments,     Trackbacks
엑셀 VBA #42 / Find메서드_기본 [VBA]
반응형

엑셀 VBA #42 / Find메서드_기본 [VBA]

 

 

 

 

예시1.

B-1제품코드의 판정값 불러오기....
For~Next구문 혹은 For Each~Next구문 사용해도 되나, 자료가 방대한 경우 속도가 느려질 수 있음.

Dim rng As Range, cf As Range

Set rng = Range("A2", Cells(Rows.Count, "A").End(xlUp))
Set cf = rng.Find(Range("D2").Value, , , xlWhole)

    'cf는 rng영역 중에서 D2셀과 같을 가지는 셀의 주소

Range("E2") = cf.Offset(, 1)

  '    'Range("E2") = cf.Offset(, 1).value'  로 해도 동일한 결과가 나오네.......




예시2
Dim rng As Range, cf As Range

Set rng = Range("A2", Cells(Rows.Count, "A").End(xlUp))
Set cf = rng.Find(Range("D2").Value, , , xlWhole)

Range("E2").ClearContents

If Not cf Is Nothing Then
    Range("E2") = cf.Offset(, 1)
Else
    MsgBox "해당되는 제품코드가 없습니다."
End if

vba#42.xlsm
0.02MB

 

Find 함수
Find 함수는 엑셀에서 데이터가 일치하거나, 또는 부분일치하는 값을 찾는 VBA 메서드(함수)이다. Find 함수의 기본 사용법은 아래와 같다.
※ 사용법
셀 범위(Range).Find(What:=찾을 값,Lookat:=xlWhole)
-. Lookat:= xlWhole 일 경우 찾을 값과 전체 일치하는 값을 찾음
   Lookat:= xlPart는 부분적으로 일치해도 값을 찾은 것으로 인식
-. 참고로 Find는 값을 찾는다고 설명하였지만 Range 의 형식을 갖는다.(아래에서 설명)
출처: https://ybworld.tistory.com/75 [투손플레이스:티스토리]

 

 

 

 

https://www.youtube.com/watch?v=tx7vfkhg0xU&list=PLfxvqpVCYZ8e0qlyc_FU46neoWjO7yTWj&index=42


반응형
  Comments,     Trackbacks
vba - intersect, event프로시져
반응형

A2:D11범위에 숫자만 입력할 수 있도록 하며, 만약 문자 입력된 경우에는 메세지박스로 안내하는 기능.

 

VBA창에서 해당 시트(test시트)를 더블클릭

 

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Columns("A:D")) Is Nothing Then
    If Target.Row > 1 And Target.Row < 12 Then
        If VBA.IsNumeric(Target) Then
        Else
            MsgBox "숫자로 입력하세요"
            Target = ""
            Target.Select
        End If
    End If
End If

End Sub

 

 

엑셀 VBA #14 / 셀 범위 선택하기_9 [VBA] - Intersect 실무예제

 

출처 : 엑셀디자인 유튜버

연관강좌 : 엑셀 VBA #86 / 이벤트프로시저+EnableEvents 활용하기 [VBA]

                 엑셀 VBA #85 / 이벤트 프로시저와 find 메서드 활용하기 [VBA]

반응형
  Comments,     Trackbacks
최근 작성 글
최근 작성 댓글
최근 작성 트랙백
프로필
공지사항
글 보관함
캘린더
«   2024/12   »
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
TODAY TOTAL