데이터 복사 Vba, 일치 기능 사용

Question

저는 새로운 코더입니다. vba의 초보자이며이를 해결하는 데 도움이되고 싶습니다. 정상적인 Excel 수식을 사용할 수 있지만 학습을위한 것임을 알고 있습니다. 여기에 지금까지 내 코드입니다 :

Sub matchpart() 
Dim ocell As Range 
Dim swb As Workbook 
Dim sws As Worksheet, dws As Worksheet 
Dim stext As String 
Dim iRow As Long 
Dim nxtRow As Long 


Set swb = ActiveWorkbook 
Set sws = swb.Sheets("sheet1") 
Set dws = swb.Sheets("sheet2") 

For Each ocell In dws.Range("FILE_NAMES") 
    stext = Left(ocell.Value, 12) 
On Error Resume Next 
iRow = Application.WorksheetFunction.Match(stext, sws.Range("ID_NUMBER"), 0) 
On Error GoTo 0 
    If iRow > 0 Then 
     Application.Index (Range("ID_PARENT").Copy) 
    Else 
     ocell.Offset(0, 1) = "" 
     End If 
     Next 

MsgBox ("Done") 
End Sub 

내 작업이 1 열 시트 1 (FILE_NAMES)와 시트 2 (ID_NUMBER) 1 열을 일치하는 것입니다.

ID_PARENT  ID_NUMBER 
pan    3 
same    2 
kappa    1 
lame    5 
dame    5 

sheet 2: 

FILE_NAMES  BPM_LIST 
1     
5 
3 
2 
4 
5 

이 사본 (일치하고있다) 시트 (1)의 다음 컬럼의 대응 값과 이후 여기 2

는 예로서 내 데이터 시트 1 인 시트의 다음 컬럼에 붙여 따라서

은 내 코드를 사용하여 BPM_LIST와 일치하고 복사하려고합니다.

Answer 1

Application.WorksheetFunction.Match(...)을 사용하지 마십시오. Application.Match(...)을 사용하고 반환 값을 변형으로 다시 전달하십시오. 그러면 IsError(...)으로 확인할 수 있습니다.

또한 (워크 시트에서 MATCH를 사용하는 것과 마찬가지로) 텍스트와 비슷한 모양의 번호를 찾을 수 없습니다. 예 : 1 <> "1". 귀하의 데이터가 실제로 어떤 것인지 (진실한 숫자 또는 문자처럼 보입니다) 모르겠지만, 일치시 stext 대신 Int(stext)을 사용해야 할 수도 있습니다.

dim iRow as variant 
For Each ocell In dws.Range("FILE_NAMES") 
    stext = Left(ocell.Value, 12) 
    iRow = Application.Match(stext, sws.Range("ID_NUMBER"), 0) 
    If IsError(iRow) Then 
     ocell.Offset(0, 1) = vbnullstring 
    Else 
     ocell.Offset(0, 1) = Range("ID_PARENT").Cells(lRow, 1).Value 
    End If 
Next ocell 

Answer 2

안녕하십니까. 내 문제에 대한 해결책을 찾았습니다. iRow와 일치하는 행 번호를 이미 가지고 있기 때문에 인덱스 함수를 사용하기 만하면됩니다. 어쨌든 도움을

Sub matchpart() 
Dim ocell As Range 
Dim ocells As Range 
Dim swb As Workbook 
Dim sws As Worksheet, dws As Worksheet 
Dim stext As String 
Dim iRow As Long 
Dim nxtRow As Long 


Set swb = ActiveWorkbook 
Set sws = swb.Sheets("sheet1") 
Set dws = swb.Sheets("sheet2") 

For Each ocell In dws.Range("FILE_NAMES") 
    stext = Left(ocell.Value, 12) 
On Error Resume Next 
iRow = Application.WorksheetFunction.Match(stext, sws.Range("ID_NUMBER"), 0) 
On Error GoTo 0 
    If iRow > 0 Then 
     ocell.Offset(0, 1) = WorksheetFunction.Index(sws.Range("ID_PARENT"), iRow, 0) 

    Else 
     ocell.Offset(0, 1) = "" 
     End If 
     Next 

MsgBox ("Done") 
End Sub 

감사합니다 :)

Answer 3

당신은 공부하고 배울 수있는 코드를 원했다. 여기있어. 나는 당신이 원하는 방향으로 코드를 조정할 수 있다고 생각하기 때문에 원하는 것을 수행하는지에 많은주의를 기울이지 않았다. 재미있어!

Sub matchpart() 
    ' 10 Apr 2017 

    Dim Wb As Workbook 
    Dim WsSrc As Worksheet     ' Identify the sheet as Source 
    Dim WsTgt As Worksheet     ' Identify the sheet as Target 
    Dim sText As String 
    Dim R As Long, lastRow As Long   ' last row in WsTgt 
    Dim iRow As Long      ' why do you call "Found row" iRow? 

    Set Wb = ActiveWorkbook     ' actually, this is the default 
    With Wb         ' declaring it just reminds you of the fact 
     Set WsSrc = .Sheets("IDs") 
     Set WsTgt = .Sheets("File Names") ' I used my own names for testing 
    End With 

    With WsTgt 
     lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
     ' most programmers prefer to call the columns by their numbers 
     ' instead of their names (like "A") as I have done here. 
     ' VBA must convert the names to numbers. 
     ' Therefore using numbers to begin with is faster. 
     ' You can change all names to numbers in this code 
     ' Just replace "A" with 1, "B" with 2 etc. 

     For R = 2 To lastRow    ' omit row 1 (captions) 
      sText = .Cells(R, "A").Value ' can't use partial with MATCH function 
      On Error Resume Next 
      iRow = WorksheetFunction.Match(sText, WsSrc.Columns("B"), 0) 
      If Err.Number = 0 Then 
       .Cells(R, "B").Value = WsSrc.Cells(iRow, "A").Value 
      End If 
      Err.Clear 
     Next R 
    End With 

    MsgBox ("Done") 
End Sub 

내 코드가 의도와 다른 부분은 "부분 일치"입니다. MATCH 워크 시트 기능을 사용하여 수행 할 수 없습니다. VBA의 찾기 기능을 사용해야합니다. 그러나 그것은 다른 날에 또 다른 교훈이 될 수 있습니다. 롤 :