VBA, Объединение таблиц в листах на основе столбца идентификатора в указанном листе - PullRequest
0 голосов
/ 05 сентября 2018

Я новичок в VBA. У меня есть два листа, содержащие две таблицы. Лист 1 представляет собой словарь сокращений в столбце под заголовком «Материал» и описания в столбце под заголовком «Описание материала». Лист 2 представляет собой набор данных, содержащий столбец под заголовком «Имена клиентов», столбец под заголовком «Материал» и столбец под заголовком «Фактурированные значения».

Пример:

Sheet 1      
Material    Material Description
   X               Hot
   B               Cold
   C               Temp
-------------------------------------
Sheet 2       
Material       Invoice Value
   X               2.7645  
   X               3.9
   B               4.6

Желаемый вывод:

Sheet 3
Material        Invoice Value
   Hot               2.7645  
   Hot               3.9
  Cold               4.6

Я пытаюсь:

  1. Найти столбцы с указанными заголовками на соответствующих листах
  2. Для каждого столбца строки «Материал» листа 1 найдите «Материал» на листе 2, который соответствует тому же «Материалу» на листе 1
  3. Заменить текст в строке столбца «Материал» на листе 2 на соответствующее значение «Описание материала» на листе 1

По пункту 1 я дошел до:

Sub Replace()

    Dim startrow As Long
    Dim custrng As Range
    Dim matdatrng As Range
    Dim valrng As Range
    Dim dscrng As Range
    Dim matname As Range

    startrow = 2

    Set rcustrng = Worksheets("Data").UsedRange.Find("Customer Name", , xlValues, xlWhole)
    Set matdatrng = Worksheets("Data").UsedRange.Find("Material", xlValues, xlWhole)
    Set valrng = Worksheets("Data").UsedRange.Find("Invoiced Value", xlValues, xlWhole)
    Set matname = Worksheets("Names").UsedRange.Find("Material", xlValues, xlWhole)
    Set dscrng = Worksheets("Names").UsedRange.Find("Material Description", xlValues, xlWhole)

End Sub

Любая помощь и предложения приветствуются, я надеюсь расширить ее до трех наборов данных.

1 Ответ

0 голосов
/ 06 сентября 2018

Я смог сделать это, используя код по следующей ссылке, предоставленной Mumps:

https://www.ozgrid.com/forum/forum/help-forums/excel-general/138286-vba-to-join-tables-with-unique-key-in-first-column

Sub CopyRange()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Sheets("OCData").Cells.Find("*", SearchOrder:=xlByRows,      SearchDirection:=xlPrevious).Row
Dim ID As Range
Dim foundID As Range
For Each ID In Sheets("OCData").Range("C2:C" & LastRow)
    Set foundID = Sheets("NamesList").Range("B:B").Find(ID, LookIn:=xlValues, lookat:=xlWhole)
    If Not foundID Is Nothing Then
        Sheets("NamesList").Range("B" & foundID.Row & ":E" & foundID.Row).Copy Sheets("OCData").Range("J" & ID.Row)
    End If
Next ID
Application.ScreenUpdating = True
End Sub

Потрясающий код, сэкономил мне массу времени.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...