Выбор и вставка ячеек

Question

Я относительно новичок в VBA, у меня есть только некоторый опыт работы с Python и очень мало опыта, глядя на другие макросы VBA и корректировка их на мою потребность, поэтому я стараюсь делать все, что в моих силах.

Что я пытаюсь сделать для каждого номера детали, вставленного в рабочий лист B (рабочий лист B, строка A) Я хочу найти тот же номер детали из другого листа, содержащего все номера деталей (рабочий лист D, строка A) и скопируйте описание (рабочий лист D, строка H) из рабочего листа D в другой столбец (рабочий лист B, строка D), затем проверьте следующий номер детали в строке и повторите.

Текущая ошибка, которую я получаю, заключается в том, что существует «Ошибка компиляции: если нет», извините, что я не очень опытный, но любая помощь будет принята с благодарностью.

Другая информация:

-Мой номера деталей для поиска через в рабочем листе B, столбец B заполняется из рабочего листа А, это хорошо, чтобы просто сделать это = A B2 или = CONCATENATE (A B2!)! ?

Sub Description() 

Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet 
Dim Rng As Range 
Set wsB = Worksheets("B") 
Set wsD = Worksheets("D") 

Do: aRow = 2 
     If wsB.Cells(aRow, 2) <> "" Then 
    With Worksheets("D").Range("A:A") 
     x = wsB.Cells(aRow, 2) 
     Set Rng = .Find(What:=x, _ 
         After:=.Cells(.Cells.Count), _ 
         LookIn:=xlValues, _ 
         LookAt:=xlWhole, _ 
         SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, _ 
         MatchCase:=False) 

     Selection.Copy 
     wsB.Cells(dRow, 2).Paste 
    dRow = dRow + 1 
    Else 
     aRow = aRow + 1 

Loop Until wsB.Cells(aRow, 2) = "" 
End Sub 

Еще раз спасибо!

Edit: не удается выполнить код в режиме останова является текущая ошибка

Sub Description() 
Dim wsA As Worksheet, wsB As Worksheet, wsC As Worksheet, wsD As Worksheet 
Dim Rng As Range 
Set wsB = Worksheets("B") 
Set wsD = Worksheets("D") 
aRow = 2 
dRow = 2 

    Do: 
     If wsB.Cells(aRow, 1) <> "" Then 
      With Worksheets("D").Range("A:A") 
       Set Rng = .Find(What:=wsB.Cells(aRow, 1), _ 
           After:=.Cells(.Cells.Count), _ 
           LookIn:=xlValues, _ 
           LookAt:=xlWhole, _ 
           SearchOrder:=xlByRows, _ 
           SearchDirection:=xlNext, _ 
           MatchCase:=False) 
       Rng.Copy 
       Rng.Offset(0, 3).Paste (Cells(aRow, 4)) 
       dRow = dRow + 1 
       aRow = aRow + 1 
      End With 
     End If 
    Loop Until wsB.Cells(aRow, 1) = "" 
End Sub 

Answer 1

Вы можете попробовать поставить End If на следующей строке после aRow = aRow + 1. См. MSDN для синтаксиса msdn.microsoft.com/en-us/library/752y8abs.aspx

Answer 2

В Excel мы обычно называем вертикальный диапазон как столбец, а горизонтальный - строкой. Из вашего кода и описания вопроса, я предполагаю, что вы сказали, что «строка A» - это столбец A. Кроме того, ваш код просматривается через wsB.Cells (aRow, 2). Это столбец B, а не столбец A. Во всяком случае, это лишь незначительная проблема.

Следующий код будет проверять ячейки столбца B из рабочего листа B. Если же значение найдено в колонке А рабочий лист D, то cooresponding ячейка в столбце Н рабочего листа D будет быть скопирована в ячейку в столбце B рабочего листа B.

Option Explicit 
Sub Description() 
    Dim wsB As Worksheet, wsD As Worksheet, aRow As Long 
    Dim rngSearchRange As Range, rngFound As Range 
    Set wsB = Worksheets("B") 
    Set wsD = Worksheets("D") 
    Set rngSearchRange = wsD.Range("A:A") 
    aRow = 2 
    Do While wsB.Cells(aRow, 2).Value <> "" 
     Set rngFound = rngSearchRange.Find(What:=wsB.Cells(aRow, 2).Value, LookAt:=xlWhole) 
     If Not rngFound Is Nothing Then 
     wsD.Cells(rngFound.Row, 8).Copy Destination:=wsB.Cells(aRow, 4) ' Indexes of Column H, D are respectively 8, 4 
     End If 
     aRow = aRow + 1 
    Loop 
End Sub 

Answer 3

Вот что сработало для меня.

Sub Description() 
    Application.ScreenUpdating = False 
    Dim LastRow As Long 
    LastRow = Sheets("B").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    Dim rng As Range 
    Dim foundRng As Range 
    For Each rng In Sheets("B").Range("B2:B" & LastRow) 
     Set foundRng = Sheets("D").Range("A:A").Find(rng, LookIn:=xlValues, lookat:=xlWhole) 
     If Not foundRng Is Nothing Then 
      Sheets("B").Cells(rng.Row, "D") = Sheets("D").Cells(foundRng.Row, "H") 
     End If 
    Next rng 
    Application.ScreenUpdating = True 
End Sub