복사 열은 시트 (2)에

Question

컬럼 A.의 규칙 세트를 가지고

A 열, 예를 각 행의 복수의 코드가, H가 행 B가 그 대응에 기반하여 데이터를 갖는다 그 코드.

시트 (1)에서

, I는 코드 중 하나를 배치 할 수 있도록 원하는 VBA 전사 로우 B를 가지고 시트 (2)로부터 H를 코드 칼럼 A. 여기

하나와 일치하면된다 I 가진 프로그램 지금까지, 그것은 행을 넘긴다. 그러나 오른쪽 행은 넘겨주지 않는다.

Dim i As Integer 
    Dim x As Integer 
    Dim row As Integer 
    Dim oldRow As Integer 
    Dim found As Boolean 
    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Set ws1 = Worksheets("Sheet1") 
    Set ws2 = Worksheets("Sheet2") 
    Dim rng As Range, cell As Range, rng2 As Range, cell2 As Range 

Set rng2 = ws2.Range("A1:A212") 
Set rng = ws1.Range("A1:A212") 

row = 1 
oldRow = 1 


For Each cell In rng 
    row = row + 1 

    For Each cell2 In rng2 
     oldRow = oldRow + 1 

     If cell.Value = cell2.Value Then 
     row = row - 1 
      ws1.Cells(row, 2) = ws2.Cells(oldRow, 2) 
      ws1.Cells(row, 3) = ws2.Cells(oldRow, 3) 
      ws1.Cells(row, 4) = ws2.Cells(oldRow, 4) 
      ws1.Cells(row, 5) = ws2.Cells(oldRow, 5) 
      ws1.Cells(row, 6) = ws2.Cells(oldRow, 6) 
      ws1.Cells(row, 7) = ws2.Cells(oldRow, 7) 
      ws1.Cells(row, 8) = ws2.Cells(oldRow, 8) 
      found = True 
     End If 



    Next 
    found = False 
    oldRow = 1 

Next 

End Sub 

감사합니다.

Answer 1

내가 이런 식으로 코드를 변경합니다 :

Sub test() 
    Dim i As Integer 
    Dim n As Integer 
    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Set ws1 = Worksheets("Sheet1") 
    Set ws2 = Worksheets("Sheet2") 

    'Cycles through the codes in sheet 1 
    For i = 2 To ws1.Cells(ws1.Rows.Count, 1).End(xlUp).row Step 1 
     For n = 2 To ws2.Cells(ws2.Rows.Count, 1).End(xlUp).row Step 1 
      If ws1.Cells(i, 1).Value = ws2.Cells(n, 1).Value Then 
       ws1.Cells(i, 2).Value = ws2.Cells(n, 2).Value 
       ws1.Cells(i, 3).Value = ws2.Cells(n, 3).Value 
       ws1.Cells(i, 4).Value = ws2.Cells(n, 4).Value 
       ws1.Cells(i, 5).Value = ws2.Cells(n, 5).Value 
       ws1.Cells(i, 6).Value = ws2.Cells(n, 6).Value 
       ws1.Cells(i, 7).Value = ws2.Cells(n, 7).Value 
       ws1.Cells(i, 8).Value = ws2.Cells(n, 8).Value 
      End If 
     Next n 
    Next i 
End Sub 

Answer 2

테스트되지 않은 :

Dim ws1 As Worksheet 
Dim ws2 As Worksheet 
Dim rng As Range, f As Range, rng2 As Range 
Dim c as range, cell as Range 


Set ws1 = Worksheets("Sheet1") 
Set ws2 = Worksheets("Sheet2") 
Set rng = ws1.Range("A1:A212") 
Set rng2 = ws2.Range("A1:A212") 

row = 1 
oldRow = 1 


For Each cell In rng.Cells 
    if len(cell.value)>0 Then 
     Set f = rng2.Find(cell.Value, lookin:=xlvalues, lookat:=xlWhole) 
     if not f is nothing then 
      cell.offset(0,1).Resize(1,7).Value = _ 
       f.offset(0,1).resize(1,7).Value 
     end if 
    end if 
Next cell 

Answer 3

이 VBA에있을이 필요합니까? 또는 VLOOKUP 워크 시트 기능을 사용할 수 있습니까? 왜냐하면 그것은 사물의 소리로부터 당신이 성취하고자하는 것입니다.

또한 사용하여 VBA에서 VLOOKUP을 사용할 수 있습니다 Application.WorksheetFunction.VLookup

당신은 루프의 시작에 대신의 말 .. 그래서 그 값을 실행하는 처음에 row 및 oldRow를 증가하기 때문에 귀하의 문제 일 수 있습니다 1 대신 2가 될 것입니다. 또한 혼란 스럽기 때문에 row = row - 1을 할 필요가 없을 것입니다.

Answer 4

수식을 사용하면됩니다. 'Sheet1의'B1 셀에 및 복사 및 아래쪽 : 그것은 매크로해야하는 경우

=IF(COUNTIF(Sheet2!$A:$A,$A1)=0,"",VLOOKUP($A1,Sheet2!$A:$H,COLUMN(B1),0)) 

,이 같은 당신을 위해 작동합니다 :

Sub tgr() 

    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Dim rngFound As Range 
    Dim arrCodes As Variant 
    Dim arrResults As Variant 
    Dim varCode As Variant 
    Dim ResultIndex As Long 
    Dim cIndex As Long 

    Set ws1 = ActiveWorkbook.Sheets("Sheet1") 
    Set ws2 = ActiveWorkbook.Sheets("Sheet2") 

    arrCodes = ws1.Range("A1", ws1.Cells(Rows.Count, "A").End(xlUp)).Value 
    If Not IsArray(arrCodes) Then Exit Sub 'No data 
    ReDim arrResults(1 To UBound(arrCodes, 1), 1 To 7) 

    For Each varCode In arrCodes 
     ResultIndex = ResultIndex + 1 
     Set rngFound = ws2.Columns("A").Find(varCode, , xlValues, xlWhole) 
     If Not rngFound Is Nothing Then 
      For cIndex = 1 To UBound(arrResults, 2) 
       arrResults(ResultIndex, cIndex) = WorksheetFunction.VLookup(varCode, ws2.Range("A:H"), cIndex + 1, False) 
      Next cIndex 
     End If 
    Next varCode 

    ws1.Range("B1").Resize(UBound(arrResults, 1), UBound(arrResults, 2)).Value = arrResults 

End Sub